8puzzles.scm

一个用广度搜索的8-puzzles问题

;;node define
(define (node-state node) (car node))
(define (node-operator node) (cadr node))
(define (node-parent node) (caddr node))
(define (make-node s o p) (list s o p))
;;generic-bfs
(define (bfs s0 sg successor-function)
  (let ((open '())
        (closed '())
        (n '())
        (son-nodes '()))
    (define (loop)
      (if (null? open) 
          "FAIL"
          (begin (set! n (car open))
                 (set! open (cdr open))
                 (set! closed (append closed (list n)))
                 
                 (if (equal? sg (node-state n))
                     (show-path n)  ;;SUCCEED, show-path
                     (begin 
                       (set! son-nodes (successor-function n))
                       (set! open (append  open 
                                           (diff son-nodes (append open closed))))   
                       
                       (loop))))))
    
    (set! open (list (make-node s0 'START 'NO-PARENT)))
    (loop)))
;;show-path
(define (show-path node)
  (if (not (pair? (node-parent node)))
      '()
      (begin (show-path (node-parent node))
             (display (node-operator node))
             (newline))))
;;proc: diff
(define (diff seq1 seq2)
  (cond ((null? seq1) '())
        ((member (car seq1) seq2)
         (diff (cdr seq1) seq2))
        (else (cons (car seq1)
                    (diff (cdr seq1) seq2)))))

;;8-puzzle procs
(define (next-move node)
  (let ((state (node-state node)))
    (let ((north-nodes (map (lambda(son-state) (make-node son-state 'NORTH node))
                            (operator-ONE state)))
          (west-nodes (map (lambda(son-state) (make-node son-state 'WEST node))
                           (operator-TWO state)))
          (south-nodes (map (lambda(son-state) (make-node son-state 'SOUTH node))
                            (operator-THREE state)))
          (east-nodes (map (lambda(son-state) (make-node son-state 'EAST node))
                           (operator-FOUR state))))
      (append north-nodes
              west-nodes
              south-nodes
              east-nodes))))

;;ugly operator-ONE
;;state is like this: ((1 2 3) (4 0 5) (6 7 8))
(define (=0? x) (= x 0))

(define (operator-ONE state)
  (let ((one (caar state))
        (two (cadar state))
        (three (caddar state))
        (four (caadr state))
        (five (cadadr state))
        (six (caddr (cadr state)))
        (seven (car (caddr state)))
        (eight (cadr (caddr state)))
        (nine (caddr (caddr state))))
    
    (cond ((member 0 (car state)) '())
          ((member 0 (cadr state))
           (cond ((=0? four) (list (list (list 0 two three)
                                         (list one five six)
                                         (list seven eight nine))))
                 ((=0? five) (list (list (list one 0 three)
                                         (list four two six)
                                         (list seven eight nine))))
                 (else (list (list (list one two 0)
                                   (list four five three)
                                   (list seven eight nine))))))
          (else
           (cond ((=0? seven) (list (list (list one two three)
                                          (list 0 five six)
                                          (list four eight nine))))
                 ((=0? eight) (list (list (list one two three)
                                          (list four 0 six)
                                          (list seven five nine))))
                 (else (list (list (list one two three)
                                   (list four five 0)
                                   (list seven eight six)))))))))
;;rotate :angle=90/180/270
(define (clockwise-rotate state angle)  
  (define (rotate-90 s)
    (map reverse (apply map (cons list s))))
  (cond ((= angle 90) (rotate-90 state))
        ((= angle 180) (rotate-90 (rotate-90 state)))
        ((= angle 270) (rotate-90 (rotate-90 (rotate-90 state))))
        (else (error "Wrong angle value: " angle))))
;;operator-TWO is to the west  
(define (operator-TWO state)
  (map (lambda(x) (clockwise-rotate x 270))
       (operator-ONE (clockwise-rotate state 90))))
;;Three , to the south
(define (operator-THREE state)
  (map (lambda(x) (clockwise-rotate x 180))
       (operator-ONE (clockwise-rotate state 180))))
;;FOUR , to the east
(define (operator-FOUR state)
  (map (lambda(x) (clockwise-rotate x 90))
       (operator-ONE (clockwise-rotate state 270))))

;;test 
(define s1 '((2 8 3) (1 6 4) (7 0 5)))
(define sg '((1 2 3) (8 0 4) (7 6 5)))
(bfs s1 sg next-move)