;;; Prof R. Williams				     Artificial Intelligence

;;;;;;;;;;;;;;;;;;;;;; General Search Pseudocode ;;;;;;;;;;;;;;;;;;;;;;

#|
Algorithm for finding one path from a given start state to some goal state.

In general, there are several possibilities:
  1. Find any one path
  2. Find all paths
  3. Find "best" path
Pseudocode given here is for the first of these.

This pseudocode avoids repeating node expansions, which potentially gains
efficiency at the cost of having to do the checking required.  If doing
this checking is not a net win, the pseudocode can be simplified by
removing all references to the CLOSED data structure.

Also, pure depth-first search can be alternatively implemented more
simply using recursion.

OPEN is a queue (list) of paths to extend
CLOSED is a data structure (best: hash table) storing nodes already visited

Initialize CLOSED as empty
Initialize OPEN to contain a single path consisting of the start node only
Repeat forever
  If OPEN is empty
    Terminate with failure
  Else
    Set PATH-TO-EXTEND to be first element in OPEN, and remove from OPEN
    Set CURRENT-NODE to be last node of PATH-TO-EXTEND
    If CURRENT-NODE satisfies goal condition
      Terminate with answer: PATH-TO-EXTEND
    Else if CURRENT-NODE not in CLOSED
      Add CURRENT-NODE to CLOSED
      Generate all successors of CURRENT-NODE not in CLOSED
      Get list of paths by extending PATH-TO-EXTEND into each successor
      Insert these paths into OPEN at beginning (depth-first)
			           at end (breadth-first)
			           in sorted order (greedy search)
|#
;;;;; Here is a direct Common Lisp implementation of this pseudocode ;;;;;

;;; The following is a fairly general-purpose driver for a state-space search
;;; algorithm.  The particular code here carries out a depth-first search,
;;; but a simple modification will turn it into breadth-first search instead.
;;; It returns the first path found from the start state to the goal state.
;;; Paths are represented as lists of states (in reverse order, so that
;;; the start state is the last element of the list and the goal state is
;;; the first element of the list).  If no such path is found, it returns nil.
;;;
;;; Fairly simple additions and modifications can also be made to this code
;;; to turn it into a best-first search program.
;;;
;;; This code implements the algorithm given in the above pseudocode
;;; (using a list for the closed node data structure, for simplicity).
;;; Note that this code maintains an explicit list of open paths, but this
;;; list of paths is not as extravagant in storage as might first be imagined
;;; since all extensions of the same path share storage because they all
;;; result from consing different states onto the same list.  (I.e., the cdrs
;;; of all the lists representing these different paths are eq.)
;;;
;;; This driver must be passed application-specific functions as the
;;; "goal-test", "successors", and "equal-states" arguments.

(defun find-path (start goal-test successors equal-states)
  (do (path-to-extend	          ; path to state currently visited
       current-node		  ; node currently visited
       candidates	          ; list of nodes to consider expanding
       extended-paths	          ; list of newly extended paths
       (closed nil)		  ; list of closed nodes
       (open (list (list start))) ; list of all candidate paths to extend
       )
      ((null open) nil)	          ; if open list is empty, search fails
      ;; comment this out when applying to nontrivial problems
      (format t                   ; lets us watch how algorithm works
	      "~%Open: ~s~%Closed: ~s~%" open closed)
      (setq path-to-extend (pop open))         ; get path at head of open list
      (setq current-node (car path-to-extend)) ; get node at end of this path
      (if (funcall goal-test current-node)     ; if at a goal node, exit
	  (return path-to-extend))  
      (unless (member current-node closed      ; skip if this node is closed
		      :test equal-states)
	(push current-node closed)          ; put this node on closed list
	(setq candidates                    ; list all non-closed successors
	      (set-difference (funcall successors current-node)
			      closed
			      :test equal-states))
	(setq extended-paths                ; construct paths to successors
	      (mapcar #'(lambda (s) (cons s path-to-extend)) candidates))
	(setq open                          ; update open list
	      (append extended-paths open)) ; designed for depth first
	)))

;;; Application-specific functions to be passed to the above procedure.
;;; NEIGHBORS returns a list of all states directly reachable from the
;;; given state in the problem graph discussed in class, SAME-STATE is
;;; a predicate that tests whether two states in the representation of
;;; this graph are the same, and GOAL-STATE tests a state to see if it
;;; satisfies the goal condition.

;;; In this simple example, states are the symbols s, a, b, c, d, e, f,
;;; and g, forming the following undirected graph:
;;;
;;;      a -- b -- c
;;;    / |    |
;;;   s  |    |      g
;;;    \ |    |     /
;;;      d -- e -- f

(defun same-state (state1 state2)	; works for symbols but may not
  (eql state1 state2))                  ;  be appropriate for lists, e.g.

(defun neighbors (state)
  (case state
	((s) '(a d))
	((a) '(s b d))
	((b) '(a c e))
	((c) '(b))
	((d) '(s a e))
	((e) '(b d f))
	((f) '(e g))
	((g) '(f))
	))

(defun goal-state (s)
  (same-state s 'g))

;;; Output from (find-path 's #'goal-state #'neighbors #'same-state)
;;; using this depth-first program:
;;; (Note: The actual output depends on the particular implementation of
;;; the set-difference function used in the above program.  In CLTL, the
;;; actual ordering of the resulting list is unspecified, and different
;;; Common Lisps may give different orderings.)
;;;
;;; Open: ((S))
;;; Closed: NIL
;;; 
;;; Open: ((A S) (D S))
;;; Closed: (S)
;;; 
;;; Open: ((B A S) (D A S) (D S))
;;; Closed: (A S)
;;; 
;;; Open: ((C B A S) (E B A S) (D A S) (D S))
;;; Closed: (B A S)
;;; 
;;; Open: ((E B A S) (D A S) (D S))
;;; Closed: (C B A S)
;;; 
;;; Open: ((D E B A S) (F E B A S) (D A S) (D S))
;;; Closed: (E C B A S)
;;; 
;;; Open: ((F E B A S) (D A S) (D S))
;;; Closed: (D E C B A S)
;;; 
;;; Open: ((G F E B A S) (D A S) (D S))
;;; Closed: (F D E C B A S)
;;; (G F E B A S)                         [This is the return value.]

;;; If the program is modified to perform breadth-first search,
;;; (find-path 's #'goal-state #'neighbors #'same-state) gives this output:
;;;
;;; Open: ((S))
;;; Closed: NIL
;;; 
;;; Open: ((A S) (D S))
;;; Closed: (S)
;;; 
;;; Open: ((D S) (B A S) (D A S))
;;; Closed: (A S)
;;; 
;;; Open: ((B A S) (D A S) (E D S))
;;; Closed: (D A S)
;;; 
;;; Open: ((D A S) (E D S) (C B A S) (E B A S))
;;; Closed: (B D A S)
;;; 
;;; Open: ((E D S) (C B A S) (E B A S))
;;; Closed: (B D A S)
;;; 
;;; Open: ((C B A S) (E B A S) (F E D S))
;;; Closed: (E B D A S)
;;; 
;;; Open: ((E B A S) (F E D S))
;;; Closed: (C E B D A S)
;;; 
;;; Open: ((F E D S))
;;; Closed: (C E B D A S)
;;; 
;;; Open: ((G F E D S))
;;; Closed: (F C E B D A S)
;;; (G F E D S)                           [This is the return value.]