; eight-puzzle skeleton code ; see the example text file eight-util.txt for usage. ; Yoonsuck Choe ; Tue Oct 1 11:23:09 CDT 2002 ;------------------------------------------------------------------------------- ; global variables: number of tiles ;------------------------------------------------------------------------------- (defvar *num-tile* 9) (defvar *num-node* 0) ;------------------------------------------------------------------------------- ; find location of number in state (0 1 2 3 4 .. 8) ;------------------------------------------------------------------------------- (defun location (number state) (let (loc) (dotimes (i *num-tile* loc) (if (= (nth i state) number) (setq loc i) nil)))) ;------------------------------------------------------------------------------- ; Swap values in two locations ;------------------------------------------------------------------------------- (defun swap (loc1 loc2 lst) (let ((new nil)) (dotimes (i *num-tile* (reverse new)) (cond ((= i loc1) (setq new (cons (nth loc2 lst) new))) ((= i loc2) (setq new (cons (nth loc1 lst) new))) (T (setq new (cons (nth i lst) new))))))) ;------------------------------------------------------------------------------- ; Look if op is applicable to state ;------------------------------------------------------------------------------- (defun applicable (op node) (let* ((state (first node)) (blank (location 0 state))) (cond ((eq op 'up) (if (and (<= 0 blank) (>= 2 blank)) nil T)) ((eq op 'down) (if (and (<= 6 blank) (>= 8 blank)) nil T)) ((eq op 'left) (if (eq 0 (mod blank 3)) nil T)) ((eq op 'right) (if (eq 2 (mod blank 3)) nil T)) (T 'failure)))) ;------------------------------------------------------------------------------- ; Apply op to state ;------------------------------------------------------------------------------- (defun apply-op (op node) (let* (new (state (first node)) (blank (location 0 state))) (setq *num-node* (+ *num-node* 1)) (list (setq new (cond ((eq op 'up) (swap blank (- blank 3) state)) ((eq op 'down) (swap blank (+ blank 3) state)) ((eq op 'left) (swap blank (- blank 1) state)) ((eq op 'right) (swap blank (+ blank 1) state)))) (+ (third node) (h new)) (+ (third node) 1) (cons op (fourth node))))) ; this is a dummy heuristic function. write your own ; this function is needed in (apply-op ..) above (defun h (state) '10000 ) ;------------------------------------------------------------------------------- ; Check if current state is goal state ;------------------------------------------------------------------------------- (defun goalp (node) (if (equal (first node) *goal-state*) T nil)) ;------------------------------------------------------------------------------- ; check for duplicate states ;------------------------------------------------------------------------------- (defun dupe (state node-list) (dolist (node node-list nil) (if (equal state (first node)) (return-from dupe T)))) ;------------------------------------------------------------------------------- ; call a function to expand ;------------------------------------------------------------------------------- (defun expand (node) (funcall *expand-func* node)) ;------------------------------------------------------------------------------- ; my-append ;------------------------------------------------------------------------------- (defun my-append (new-q old-q) (let ((result old-q)) (dolist (new (reverse new-q) result) (setq result (cons new result))))) ;------------------------------------------------------------------------------- ; Print result ;------------------------------------------------------------------------------- (defun print-result (node) (print (format NIL "~%~%PATH: ~A ~%DEPTH: ~D ~%" (reverse (fourth node)) (third node))) T) ;------------------------------------------------------------------------------- ; Print puzzle ;------------------------------------------------------------------------------- (defun print-tile (state) (print (format NIL "~%")) (dotimes (i 3 T) (print (format NIL " ~A ~A ~A" (nth (* 3 i) state) (nth (+ (* 3 i) 1) state) (nth (+ (* 3 i) 2) state))))) ;------------------------------------------------------------------------------- ; Print answer ;------------------------------------------------------------------------------- (defun print-answer (state path) (let ((blank (location 0 state))) (print-tile state) (cond ((null path) T) ((eq 'up (first path)) (print-answer (swap blank (- blank 3) state) (rest path))) ((eq 'down (first path)) (print-answer (swap blank (+ blank 3) state) (rest path))) ((eq 'left (first path)) (print-answer (swap blank (- blank 1) state) (rest path))) ((eq 'right (first path)) (print-answer (swap blank (+ blank 1) state) (rest path))))))