Advertisement
zbeucler

grid-BFS.ss

Feb 22nd, 2021
223
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.07 KB | None | 0 0
  1. (define expand
  2. (lambda (point)
  3. (let ((lst (adjacentv point)))
  4. (set-lst-frontier lst)
  5. (add-to-path-lst lst point)
  6. (enqueue lst))))
  7.  
  8. (define add-to-path-lst
  9. (lambda (lst point)
  10. (if (not (null? lst))
  11. (let ((child-parent (list (car lst) point)))
  12. (set! path-lst (cons child-parent path-lst))
  13. (add-to-path-lst (cdr lst) point)))))
  14.  
  15. (define set-lst-frontier
  16. (lambda (lst)
  17. (if (null? lst)
  18. '()
  19. (let ((x (car lst)))
  20. (draw-pt-frontier x)
  21. (block-set! x frontier)
  22. (set-lst-frontier (cdr lst))))))
  23.  
  24. (define draw-pt-frontier
  25. (lambda (pt)
  26. (draw-frontier (car pt) (cadr pt))))
  27.  
  28. (define search
  29. (lambda (grid stop-count)
  30. (block-set! start frontier)
  31. (set! path-lst (list (list start '())))
  32. (search2 grid 1 stop-count)))
  33.  
  34. (define search2
  35. (lambda (grid count stop-count)
  36. ;(display queue) (newline)
  37. (pause pause-num)
  38. (display count)
  39. (newline)
  40. (expand robot)
  41. (let ((next-robot (front)))
  42. (cond
  43. ((null? next-robot)
  44. (display "Cannot reach the goal")
  45. (newline))
  46. ((equal? next-robot goal)
  47. (set! robot (dequeue))
  48. (draw-moved-robot (robot-x) (robot-y))
  49. (display "Found")
  50. (newline)
  51. (let ((path (get-path goal)))
  52. (draw-path path)
  53. (display path))
  54. (newline))
  55. ((>= count stop-count)
  56. (display "Took too long")
  57. (new line))
  58. (else
  59. (draw-visited (car robot) (cadr robot))
  60. (set! robot (dequeue))
  61. (draw-moved-robot (robot-x) (robot-y))
  62. (search2 grid (+ count 1) stop-count))))))
  63.  
  64. (define get-path
  65. (lambda (last-node)
  66. (if (equal? last-node start)
  67. (list start)
  68. (let ((next-node (cadr (assoc last-node path-lst))))
  69. (append (get-path next-node) (list last-node))))))
  70.  
  71. (define draw-path
  72. (lambda (path)
  73. (cond
  74. ((not (null? path))
  75. (draw-pt-path-node (car path))
  76. (draw-path (cdr path))))))
  77.  
  78.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement