Я смотрел на реализацию bfs в схеме для решения проблемы 8 головоломок, это код, который у меня есть до сих пор (из-за некоторой ошибки, которую я не могу отладить) ::
;;some operators for defining the strucuture
(define blank 'blank)
(define depth 0)(define path-cost 0)
(define nw 0)
(define n 1)
(define ne 2)
(define w 3)
(define c 4)
(define e 5)
(define sw 6)
(define s 7)
(define se 8)
(define left 'left)
(define right 'right)
(define up 'up)
(define down 'down)
;;the function to make a node
(define make-node
(lambda (state parent operator depth path-cost)
(list state parent operator depth path-cost)))
(define expand-procedure
(lambda (curr rest)
(append rest (gen-nodes curr (valid-moves (car curr))))))
(define gen-nodes
(lambda (node moves)
(cond
[(null? moves) '()]
[else
(letrec ((gen-states
(lambda (node operator moves)
(if (pair? moves)
(cons
(make-node (operator (car node)) (append (car node) (car (cdr node))) operator (+ 1 (car(cdr(cdr(cdr node))))) 1)
(gen-states node (car moves) (cdr moves)))
(make-node (operator (car node)) (append (car node) (car (cdr node))) operator (+ 1 (car(cdr(cdr(cdr node))))) 1)))))
(gen-states node (car moves) (cdr moves)))])))
(define not-visited-parent
(lambda (list new)
(if (pair? list)
(if (eqv? new (car list))
#f
(not-visited (cdr list) new))
(if (eqv? new list)
#f
#t))))
(define not-visited-other
(lambda (list new)
(if (pair? list)
(if (eqv? new (car (car list)))
#f
(not-visited (cdr list) new))
(if (eqv? new (car list))
#f
#t))))
(define find-blank
(lambda (ls ref)
(cond
[(eq? ref 9) null]
[(eq? (list-ref ls ref) 'blank) ref]
[else (find-blank ls (+ ref 1))])))
;;operators to move the blank
(define left
(lambda (state)
(swap state (find-blank state 0) (- (find-blank state 0) 1))))
(define right
(lambda (state)
(swap state (find-blank state 0) (+ (find-blank state 0) 1))))
(define up
(lambda (state)
(swap state (find-blank state 0) (- (find-blank state 0) 3))))
(define down
(lambda (state)
(swap state (find-blank state 0) (+ (find-blank state 0) 3))))
;set ref1 to value from ref 2
(define set-ref!
(lambda (list ref1 value iter)
(if (eqv? iter 9)
'()
(if (pair? list)
(cons
(if (eq? ref1 iter)
value
(list-ref list iter))
(set-ref! list ref1 value (+ iter 1)))
(if (eq? ref1 iter)
value
(list-ref list iter))))))
(define swap
(lambda (state ref1 ref2)
(begin
(define temp (list-ref state ref1))
(set! state (set-ref! state ref1 (list-ref state ref2) 0))
(set! state (set-ref! state ref2 temp 0))
state)))
;;returns the valid moves for the given state
(define valid-moves
(lambda (state)
(case (find-blank state 0)
([0] (list right down))
([1] (list left right down))
([2] (list left down))
([3] (list right up down))
([4] (list left right up down))
([5] (list left up down))
([6] (list right up))
([7] (list left right up))
([8] (list left up))
(else '()))))
;;procedure to test if we have reached the goal state
(define test-procedure
(lambda (state)
(if (eq? (car state) goal)
#t
#f)))
;;the general search procedure
(define general-search
(lambda (queue test-procedure expand-procedure limit num-runs output-procedure)
(cond
[(null? queue) #f] ;queue is empty - goal state not found - very very unlikely scenario - unless some bozo goes out of state space
[(test-procedure (car queue)) (output-procedure num-runs (car queue))] ;reached goal state??
[(zero? limit) "Limit reached"] ;limit reached stop
[else (general-search
(expand-procedure (car queue) (cdr queue))
test-procedure expand-procedure (- limit 1) (+ num-runs 1) output-procedure)])))
(define output-procedure
(lambda (num-runs node)
(begin
(display num-runs)
(display "\n")
(display (list-ref (car node) nw))
(display (list-ref (car node) n))
(display (list-ref (car node) ne))
(display "\n")
(display (list-ref (car node) w))
(display (list-ref (car node) c))
(display (list-ref (car node) e))
(display "\n")
(display (list-ref (car node) sw))
(display (list-ref (car node) s))
(display (list-ref (car node) se)))))
;;The test functions
(define make-initial-state
(lambda (nw n ne w c e sw s se)
(list nw n ne w c e sw s se)))
(define make-goal-state
(lambda (nw n ne w c e sw s se)
(list nw n ne w c e sw s se)))
(define test-uninformed-search
(lambda (init goal limit)
(begin
(define queue (list (make-node init '() '() 0 1)))
(general-search queue test-procedure expand-procedure limit 0 output-procedure))))
(define init (make-initial-state 1 2 3 4 5 6 7 blank 8))
(define goal (make-goal-state 1 2 3 4 5 6 7 8 blank))
(test-uninformed-search init goal 2000)