Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ; read input
- (defun read-input(p)
- (cond
- ((null p) nil)
- (T (cons p (read-input (read nil nil))))
- )
- )
- (defun readinput(i)
- (cdr (read-input 1))
- )
- (defun run-breadth (start goal moves)
- (declare (special *open*))
- (declare (special *closed*))
- (declare (special *goal*))
- (setq *open* (list (build-record start nil)))
- (setq *closed* nil)
- (setq *goal* goal)
- (breadth-first moves))
- ;;; These functions handle the creation and access of (state parent)
- ;;; pairs.
- (defun build-record (state parent) (list state parent))
- (defun get-state (state-tuple) (nth 0 state-tuple))
- (defun get-parent (state-tuple) (nth 1 state-tuple))
- (defun retrieve-by-state (state list)
- (cond ((null list) nil)
- ((equal state (get-state (car list))) (car list))
- (t (retrieve-by-state state (cdr list)))))
- (defun breadth-first (moves)
- (declare (special *open*))
- (declare (special *closed*))
- (declare (special *goal*))
- (cond ((null *open*) nil)
- (t (let ((state (car *open*)))
- (setq *closed* (cons state *closed*))
- (cond
- ;;; found solution: print path to it
- ((equal (get-state state) *goal*) (reverse (build-solution *goal*)))
- ;;; try next child state
- (t (setq *open*
- (append (cdr *open*)
- (generate-descendants (get-state state)
- moves)))
- (breadth-first moves)))))))
- (defun generate-descendants (state moves)
- (declare (special *open*))
- (declare (special *closed*))
- (cond ((null moves) nil)
- (t (let ((child (funcall (car moves) state))
- (rest (generate-descendants state (cdr moves))))
- (cond ((null child) rest)
- ((retrieve-by-state child rest) rest)
- ((retrieve-by-state child *open*) rest)
- ((retrieve-by-state child *closed*) rest)
- (t (cons (build-record child state) rest)))))))
- (defun build-solution (state)
- (declare (special *closed*))
- (cond ((null state) nil)
- (t (cons state (build-solution
- (get-parent
- (retrieve-by-state state *closed*)))))))
- (defvar *initial* (car (readinput nil)))
- ;--don't change above this line
- ; write your function(s) here
- (defun opposite (num)
- (cond
- ( (eq (nth 2 num) 1) (list (nth 0 num) (nth 1 num) 0))
- ( T (list (nth 0 num) (nth 1 num) 1) )
- )
- )
- (defun change-pos (state pos)
- (cond
- ( (eq pos 1) (append (list (opposite (car state))) (cdr state)) )
- ( T (append (list (car state)) (change-pos (cdr state) (- pos 1))) )
- )
- )
- (defun move1 (state)
- (change-pos (change-pos (change-pos state 4) 2) 1)
- )
- (defun move2 (state)
- (change-pos (change-pos (change-pos (change-pos state 5) 3) 2) 1)
- )
- (defun move3 (state)
- (change-pos (change-pos (change-pos state 3) 2) 6)
- )
- (defun move4 (state)
- (change-pos (change-pos (change-pos (change-pos state 1) 4) 5) 7)
- )
- (defun move5 (state)
- (change-pos (change-pos (change-pos (change-pos (change-pos state 5) 2) 4) 6) 8)
- )
- (defun move6 (state)
- (change-pos (change-pos (change-pos (change-pos state 6) 3) 5) 9)
- )
- (defun move7 (state)
- (change-pos (change-pos (change-pos state 7) 4) 8)
- )
- (defun move8 (state)
- (change-pos (change-pos (change-pos (change-pos state 8) 7) 9) 5)
- )
- (defun move9 (state)
- (change-pos (change-pos (change-pos state 9) 6) 8)
- )
- (print (run-breadth *initial* '((0 0 0) (0 1 0) (0 2 0) (1 0 0) (1 1 0) (1 2 0) (2 0 0) (2 1 0) (2 2 0)) '(move1 move2 move3 move4 move5 move6 move7 move8 move9)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement