8-puzzle bfs scheme implementation

Question

i was looking at implementing the bfs in scheme to solve the 8 puzzle problem, this is the code i have so far (giving some error im unable to debug)::

;;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)

need some ideas for checking if the current state is already part of the discovered nodes :( — knk

Theo Belaire Theo Belaire · Accepted Answer · 2010-11-05T02:42:30

I'm getting

module: duplicate definition for identifier in: left

as an error, which means you are defining left for than once. (I'm running it in DrRacket, so that might be different from yours.)

Try fixing that first.

8-puzzle bfs scheme implementation

1 Answers