;;; insert-by-weight will add new child states to an ordered list of ;;; states-to-try. (defun insert-by-weight (children sorted-list) (cond ((null children) sorted-list) (t (insert (car children) (insert-by-weight (cdr children) sorted-list))))) (defun insert (item sorted-list) (cond ((null sorted-list) (list item)) ((< (get-weight item) (get-weight (car sorted-list))) (cons item sorted-list)) (t (cons (car sorted-list) (insert item (cdr sorted-list)))))) ;;;(run-best '(e e e e e e e) '(w w w w w w w)) ;;;run-best is a simple top-level "calling" function to run best-first-search (defun run-best (start goal) (setq *goal* goal) (setq *open* (list (build-record start nil 0 (heuristic start)))) (setq *closed* nil) (best-first)) ;;; These functions handle the creation and access of (state parent) ;;; pairs. (defun build-record (state parent depth weight) (list state parent depth weight)) (defun get-state (state-tuple) (nth 0 state-tuple)) (defun get-parent (state-tuple) (nth 1 state-tuple)) (defun get-depth (state-tuple) (nth 2 state-tuple)) (defun get-weight (state-tuple) (nth 3 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))))) ;; best-first defines the actual best-first search algorithm ;;; it uses "global" open and closed lists. (defun best-first () (print "open =") (print *open*) (print "closed =") (print *closed*) (cond ((null *open*) nil) (t (let ((state (car *open*))) (setq *closed* (cons state *closed*)) (cond ((equal (get-state state) *goal*) (build-solution *goal*)) (t (setq *open* (insert-by-weight (generate-descendants (get-state state) (1+ (get-depth state)) *moves*) (cdr *open*))) (best-first))))))) ;;; generate-descendants produces all the descendants of a state (defun generate-descendants (state depth moves) (cond ((null moves) nil) (t (let ((child (funcall (car moves) state)) (rest (generate-descendants state depth (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 depth (+ depth (heuristic child))) rest))))))) (defun build-solution (state) (cond ((null state) nil) (t (cons state (build-solution (get-parent (retrieve-by-state state *closed*))))))) ;;; evaluate the move rule definitions ;;; and bind them to the gloabl variable, *moves*: (setq *moves* '(j1_takes_self j2_takes_self j3_takes_self p1_takes_self p2_takes_self p3_takes_self j1_takes_j2 j1_takes_j3 j1_takes_p1 j1_takes_p2 j1_takes_p3 j2_takes_j3 j2_takes_p1 j2_takes_p2 j2_takes_p3 j3_takes_p1 j3_takes_p2 j3_takes_p2 p1_takes_p2 p1_takes_p3 p2_takes_p3)) (defun heuristic (state) (heuristic-eval state *goal*)) (defun heuristic-eval (state goal) (cond ( (null state) 0 ) ( (equal (car state) (car goal)) (heuristic-eval (cdr state) (cdr goal)) ) ( t (1+ (heuristic-eval (cdr state) (cdr goal))) ) ) ) ;;;(solve-pandj '(e e e e e e e) '(w w w w w w w)) (defun solve-pandj (state goal) (path state goal nil)) ;;; The recursive path algorithm searches the space in a depth first ;;; fashion. (defun path (state goal been-list) (cond ((null state) nil) ((equal state goal) (reverse (cons state been-list))) ( (not (member state been-list :test #'equal)) (or (path (j1_takes_self state) goal (cons state been-list)) (path (j2_takes_self state) goal (cons state been-list)) (path (j3_takes_self state) goal (cons state been-list)) (path (p1_takes_self state) goal (cons state been-list)) (path (p2_takes_self state) goal (cons state been-list)) (path (p3_takes_self state) goal (cons state been-list)) (path (j1_takes_j2 state) goal (cons state been-list)) (path (j1_takes_j3 state) goal (cons state been-list)) (path (j1_takes_p1 state) goal (cons state been-list)) (path (j1_takes_p2 state) goal (cons state been-list)) (path (j1_takes_p3 state) goal (cons state been-list)) (path (j2_takes_j3 state) goal (cons state been-list)) (path (j2_takes_p1 state) goal (cons state been-list)) (path (j2_takes_p2 state) goal (cons state been-list)) (path (j2_takes_p3 state) goal (cons state been-list)) (path (j3_takes_p1 state) goal (cons state been-list)) (path (j3_takes_p2 state) goal (cons state been-list)) (path (j3_takes_p2 state) goal (cons state been-list)) (path (p1_takes_p2 state) goal (cons state been-list)) (path (p1_takes_p3 state) goal (cons state been-list)) (path (p2_takes_p3 state) goal (cons state been-list)) ) ) ) ) ;;; These functions define legal moves in the state space. They take ;;; a state as argument, and return the state produced by that operation. ;;; nil is returned if the given state is not safe or valid (defun j1_takes_self (state) (cond ( (equal (b-side state) (j1-side state)) (safe (make-state (opposite (j1-side state)) (j2-side state) (j3-side state) (p1-side state) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j2_takes_self (state) (cond ( (equal (b-side state) (j2-side state)) (safe (make-state (j1-side state) (opposite (j2-side state)) (j3-side state) (p1-side state) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j3_takes_self (state) (cond ( (equal (b-side state) (j3-side state)) (safe (make-state (j1-side state) (j2-side state) (opposite (j3-side state)) (p1-side state) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun p1_takes_self (state) (cond ( (equal (b-side state) (p1-side state)) (safe (make-state (j1-side state) (j2-side state) (j3-side state) (opposite (p1-side state)) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun p2_takes_self (state) (cond ( (equal (b-side state) (p2-side state)) (safe (make-state (j1-side state) (j2-side state) (j3-side state) (p1-side state) (opposite (p2-side state)) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun p3_takes_self (state) (cond ( (equal (b-side state) (p3-side state)) (safe (make-state (j1-side state) (j2-side state) (j3-side state) (p1-side state) (p2-side state) (opposite (p3-side state)) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j1_takes_j2 (state) (cond ( (and (equal (b-side state) (j1-side state)) (equal (j1-side state) (j2-side state))) (safe (make-state (opposite (j1-side state)) (opposite (j2-side state)) (j3-side state) (p1-side state) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j1_takes_j3 (state) (cond ( (and (equal (b-side state) (j1-side state)) (equal (j1-side state) (j3-side state))) (safe (make-state (opposite (j1-side state)) (j2-side state) (opposite (j3-side state)) (p1-side state) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j1_takes_p1 (state) (cond ( (and (equal (b-side state) (j1-side state)) (equal (j1-side state) (p1-side state))) (safe (make-state (opposite (j1-side state)) (j2-side state) (j3-side state) (opposite (p1-side state)) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j1_takes_p2 (state) (cond ( (and (equal (b-side state) (j1-side state)) (equal (j1-side state) (p2-side state))) (safe (make-state (opposite (j1-side state)) (j2-side state) (j3-side state) (p1-side state) (opposite (p2-side state)) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j1_takes_p3 (state) (cond ( (and (equal (b-side state) (j1-side state)) (equal (j1-side state) (p3-side state))) (safe (make-state (opposite (j1-side state)) (j2-side state) (j3-side state) (p1-side state) (p2-side state) (opposite (p3-side state)) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j2_takes_j3 (state) (cond ( (and (equal (b-side state) (j2-side state)) (equal (j2-side state) (j3-side state))) (safe (make-state (j1-side state) (opposite (j2-side state)) (opposite (j3-side state)) (p1-side state) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j2_takes_p1 (state) (cond ( (and (equal (b-side state) (j2-side state)) (equal (j2-side state) (p1-side state))) (safe (make-state (j1-side state) (opposite (j2-side state)) (j3-side state) (opposite (p1-side state)) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j2_takes_p2 (state) (cond ( (and (equal (b-side state) (j2-side state)) (equal (j2-side state) (p2-side state))) (safe (make-state (j1-side state) (opposite (j2-side state)) (j3-side state) (p1-side state) (opposite (p2-side state)) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j2_takes_p3 (state) (cond ( (and (equal (b-side state) (j2-side state)) (equal (j2-side state) (p3-side state))) (safe (make-state (j1-side state) (opposite (j2-side state)) (j3-side state) (p1-side state) (p2-side state) (opposite (p3-side state)) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j3_takes_p1 (state) (cond ( (and (equal (b-side state) (j3-side state)) (equal (j3-side state) (p1-side state))) (safe (make-state (j1-side state) (j2-side state) (opposite (j3-side state)) (opposite (p1-side state)) (p2-side state) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j3_takes_p2 (state) (cond ( (and (equal (b-side state) (j3-side state)) (equal (j3-side state) (p2-side state))) (safe (make-state (j1-side state) (j2-side state) (opposite (j3-side state)) (p1-side state) (opposite (p2-side state)) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun j3_takes_p3 (state) (cond ( (and (equal (b-side state) (j3-side state)) (equal (j3-side state) (p3-side state))) (safe (make-state (j1-side state) (j2-side state) (opposite (j3-side state)) (p1-side state) (p2-side state) (opposite (p3-side state)) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun p1_takes_p2 (state) (cond ( (and (equal (b-side state) (p1-side state)) (equal (p1-side state) (p2-side state))) (safe (make-state (j1-side state) (j2-side state) (j3-side state) (opposite (p1-side state)) (opposite (p2-side state)) (p3-side state) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun p1_takes_p3 (state) (cond ( (and (equal (b-side state) (p1-side state)) (equal (p1-side state) (p3-side state))) (safe (make-state (j1-side state) (j2-side state) (j3-side state) (opposite (p1-side state)) (p2-side state) (opposite (p3-side state)) (opposite (b-side state)) ) ) ) (t nil) ) ) (defun p2_takes_p3 (state) (cond ( (and (equal (b-side state) (p2-side state)) (equal (p2-side state) (p3-side state))) (safe (make-state (j1-side state) (j2-side state) (j3-side state) (p1-side state) (opposite (p2-side state)) (opposite (p3-side state)) (opposite (b-side state)) ) ) ) (t nil) ) ) ;;; These functions define states of the world ;;; as an abstract data type. (defun make-state (j1 j2 j3 p1 p2 p3 b) (list j1 j2 j3 p1 p2 p3 b)) (defun j1-side ( state ) (nth 0 state)) (defun j2-side ( state ) (nth 1 state)) (defun j3-side ( state ) (nth 2 state)) (defun p1-side ( state ) (nth 3 state)) (defun p2-side ( state ) (nth 4 state)) (defun p3-side ( state ) (nth 5 state)) (defun b-side ( state ) (nth 6 state)) ;;; The function "opposite" takes a side and returns the opposite ;;; side of the river. (defun opposite (side) (cond ((equal side 'e) 'w) ((equal side 'w) 'e))) ;;; Safe returns nil if a state is not safe; it returns the state unchanged ;;; if it is safe. (defun safe (state) (cond ( (and (equal (j1-side state) (j2-side state)) (equal (j1-side state) (j3-side state)) ) state ) ( (and (equal (p1-side state) (p2-side state)) (equal (p1-side state) (p3-side state)) ) nil ) ( (or (and (equal (j1-side state) (p1-side state)) (not(equal (j1-side state) (p2-side state))) (not(equal (j1-side state) (p3-side state))) (not(equal (j1-side state) (j2-side state))) (not(equal (j1-side state) (j3-side state))) ) (and (equal (j1-side state) (p2-side state)) (not(equal (j1-side state) (p1-side state))) (not(equal (j1-side state) (p3-side state))) (not(equal (j1-side state) (j2-side state))) (not(equal (j1-side state) (j3-side state))) ) (and (equal (j1-side state) (p3-side state)) (not(equal (j1-side state) (p2-side state))) (not(equal (j1-side state) (p1-side state))) (not(equal (j1-side state) (j2-side state))) (not(equal (j1-side state) (j3-side state))) ) ) state ) ( (or (and (equal (j2-side state) (p1-side state)) (not(equal (j2-side state) (p2-side state))) (not(equal (j2-side state) (p3-side state))) (not(equal (j2-side state) (j1-side state))) (not(equal (j2-side state) (j3-side state))) ) (and (equal (j2-side state) (p2-side state)) (not(equal (j2-side state) (p1-side state))) (not(equal (j2-side state) (p3-side state))) (not(equal (j2-side state) (j1-side state))) (not(equal (j2-side state) (j3-side state))) ) (and (equal (j2-side state) (p3-side state)) (not(equal (j2-side state) (p2-side state))) (not(equal (j2-side state) (p1-side state))) (not(equal (j2-side state) (j1-side state))) (not(equal (j2-side state) (j3-side state))) ) ) state ) ( (or (and (equal (j3-side state) (p1-side state)) (not(equal (j3-side state) (p2-side state))) (not(equal (j3-side state) (p3-side state))) (not(equal (j3-side state) (j1-side state))) (not(equal (j3-side state) (j2-side state))) ) (and (equal (j3-side state) (p2-side state)) (not(equal (j3-side state) (p1-side state))) (not(equal (j3-side state) (p3-side state))) (not(equal (j3-side state) (j1-side state))) (not(equal (j3-side state) (j2-side state))) ) (and (equal (j3-side state) (p3-side state)) (not(equal (j3-side state) (p2-side state))) (not(equal (j3-side state) (p1-side state))) (not(equal (j3-side state) (j1-side state))) (not(equal (j3-side state) (j2-side state))) ) ) state ) (t nil) ) )