LISP

;;; This is one of the example programs from the textbook:
;;;
;;; Artificial Intelligence: 
;;; Structures and strategies for complex problem solving
;;;
;;; by George F. Luger and William A. Stubblefield
;;; 
;;; These programs are copyrighted by Benjamin/Cummings Publishers.
;;;
;;; We offer them for use, free of charge, for educational purposes only.
;;;
;;; Disclaimer: These programs are provided with no warranty whatsoever as to
;;; their correctness, reliability, or any other property.  We have written 
;;; them for specific educational purposes, and have made no effort
;;; to produce commercial quality computer programs.  Please do not expect 
;;; more of them then we have intended.
;;;

;;;
;;; This code has been tested with CMU Common Lisp CVS release-19a
;;; 19a-release-20040728 and appears to function as intended.

;;; This file contains a simple general breadth first search algorithm
;;; described in chapter 7 of the text.
;;; although it finds solutions, it does not reproduce the path to them.
;;; A more useful algorithm that does so is described in the 
;;; file breadth_first_search_2.lisp


;;; To run it on the farmer, wolf, goat and cabbage problem,
;;; use the farmer, wolf, goat and cabbage rules defined
;;; in the file farmer_wolf_etc_rules_only.lisp.  Bind the
;;; global variable *moves* to those rules by evaluating:

;;; (setq *moves* 
;;;       '(farmer-takes-self farmer-takes-wolf 
;;;         farmer-takes-goat farmer-takes-cabbage))
;;;
;;; Then evaluate (run-breadth '(e e e e) '(w w w w))
;;; 

(defun run-breadth (start goal)
  (declare (special *open*)
           (special *closed*)
           (special *goal*))
  (setq *open* (list start))
  (setq *closed* nil)
  (setq *goal* goal)
  (breadth-first))


(defun breadth-first ()
  (declare (special *open*)
           (special *closed*)
           (special *goal*)
           (special *moves*))
  (cond ((null *open*) nil)
        (t (let ((state (car *open*)))
             (cond ((equal state *goal*) 'success)
                   (t (setq *closed* (cons state *closed*))
                      (setq *open* 
                            (append (cdr *open*)
                                    (generate-descendants state *moves*)))
                      (breadth-first)))))))

;;; Generates all the descendants of a given state.

(defun generate-descendants (state moves)
  (declare (special *open*)
           (special *closed*))
  (cond ((null moves) nil)
        (t (let ((child (funcall (car moves) state))
                 (rest (generate-descendants state (cdr moves))))
             (cond ((null child) rest)
                   ((member child rest :test #'equal) rest)
                   ((member child *open* :test #'equal) rest)
                   ((member child *closed* :test #'equal) rest)
                   (t (cons child rest)))))))



  

Close Window