Advertisement
zbeucler

grid-BFS.ss

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