;;;
;;; A generic state space search framework
;;;
;;; By Philip W. L. Fong
;;;

;;;
;;; Search Node
;;;
;;; The search routine generates and expands search nodes incrementally.
;;; Search nodes that are generated but not yet expanded are stored 
;;; in a container data structure called a node store. 
;;;
;;; The designer of a search problem does not need to know the internal
;;; structure of a search node.  However, programmers
;;; who want to customize the node expansion strategy of the 
;;; search routine will need to understand the structure of a node
;;; object.
;;;

(defun make-node (state operator depth path-cost parent)
  "A search node in the search tree.
   STATE    : A LISP expression representing a state in the search space.
   OPERATOR : An identifier of the operator that generates this node.
   DEPTH    : Depth of this node.
   PATH-COST: Cost of the path leading to this node.
   PARENT   : The parent node of this node."
  (list state operator depth path-cost parent))

(defun node-state (node)
  "The state represented by NODE."
  (first node))

(defun node-operator (node)
  "The identifier of the operator that generates NODE."
  (second node))

(defun node-depth (node)
  "The depth of NODE in the search tree."
  (third node))

(defun node-path-cost (node)
  "The cost of the path leading to NODE."
  (fourth node))

(defun node-parent (node)
  "The parent node of NODE in the search tree."
  (fifth node))

(defun make-root-node (initial-state)
  "Create the root node of a search tree."
  (make-node initial-state     ; state
	     'initial-state    ; operator
	     0                 ; depth
	     0                 ; path-cost
	     nil))             ; parent

;;;
;;; A successor function is a function that, when given a state, returns
;;; a (possibly empty) list of effect structures.  The designer of 
;;; a search problem needs to encode the effect of operator application
;;; in terms of this structure.
;;;

(defun make-effect (operator cost state)
  "The effect of applying an operator.
   OPERATOR: An identifier expression for the operator.
   COST    : Cost of applying the operator.
   STATE   : The state generated by this operator application."
  (list operator cost state))

(defun effect-operator (effect)
  "The identifier of the operator producing EFFECT."
  (first effect))

(defun effect-cost (effect)
  "The cost of applying the operator that produces EFFECT."
  (second effect))

(defun effect-state (effect)
  "The state represented by EFFECT."
  (third effect))

(defun expand-node (successor-func node)
  "A helper function that turns the effects of node expansion to search nodes."
  (mapcar #'(lambda (effect)
	      (make-node (effect-state effect)     ; state
			 (effect-operator effect)  ; operator
			 (1+ (node-depth node))    ; depth
			 (+ (effect-cost effect)   ; path-cost
			    (node-path-cost node))
			 node))                    ; parent
	  (funcall successor-func (node-state node))))

;;;
;;; Search problem
;;;
;;; A user may specify a search problem by constructing a problem object.
;;;

(defun make-problem (initial-state successor-func goal-test)
  "A problem structure specifies the initial state, the successor function, 
and goal test, and the path cost function for a search problem."
  (list initial-state successor-func goal-test))

(defun problem-initial-state (problem)
  "The initial state of PROBLEM."
  (first problem))

(defun problem-successor-func (problem)
  "The successor function of PROBLEM."
  (second problem))

(defun problem-goal-test (problem)
  "The goal test of PROBLEM."
  (third problem))

;;;
;;; Search strategy
;;;

(defun make-strategy (node-store-insert
		      node-store-remove
		      node-store-empty-p
		      pruning-test)
  "A strategy object provides access functions for a node store and
a predicate for testing if a given node should be pruned.
   NODE-STORE-INSERT  : A single-argument function that produces the
                          side effect of inserting a given search node
                          into the node store.    
   NODE-STORE-REMOVE  : A zero-argument function that has the side effect
                          of removing a node from the node store, and a
                          return value of the removed node.
   NODE-STORE-EMPTY-P : A zero-argument predicate to test if the node 
                          store is empty.
   PRUNING-TEST       : A single-argument predicate to test if a given 
                          search node is to be pruned."
  (list node-store-insert
	node-store-remove
	node-store-empty-p
	pruning-test))

(defun strategy-node-store-insert (strategy)
  "Return a single-argument function, when called with a search node
as input, will produce the side effect of inserting the node into
the node store."
  (first strategy))

(defun strategy-node-store-remove (strategy)
  "Return a zero-argument function that produces the side effect
of remove a node from the node store and returns the remove node."
  (second strategy))

(defun strategy-node-store-empty-p (strategy)
  "Return a zero-argument predicate that tests if the node store is empty."
  (third strategy))

(defun strategy-pruning-test (strategy)
  "Return a single-argument predicate that tests if a given node is to
be pruned."
  (fourth strategy))

;;;
;;; Generic Search 
;;;
;;; Main entry point to the search routine.
;;;

(defun generic-search (problem strategy)
  "Search for a goal node of PROBLEM using STRATEGY.  Return four
values: goal node (or the atom 'failure if none exists), the number
of nodes expanded, the number of nodes generated, and the number of
nodes pruned."
  (let
      ((initial-state      (problem-initial-state  problem))
       (successor-func     (problem-successor-func problem))
       (goal-test          (problem-goal-test      problem))
       (node-store-insert  (strategy-node-store-insert  strategy))
       (node-store-remove  (strategy-node-store-remove  strategy))
       (node-store-empty-p (strategy-node-store-empty-p strategy))
       (pruning-test       (strategy-pruning-test       strategy))
       (nodes-expanded     0)
       (nodes-generated    0)
       (nodes-pruned       0)
       (node               nil))
    ;; create root node of the search tree and insert it into node store
    (funcall node-store-insert (make-root-node initial-state))
    (incf nodes-generated) ; collect statistics
    ;; main search loop
    (loop
     ;; search fails if node store becomes empty
     (if (funcall node-store-empty-p)
	 (return-from generic-search
		      (values 'failure nodes-expanded nodes-generated 
			      nodes-pruned)))
     ;; remove next node from node store
     (setf node (funcall node-store-remove))
     ;; return node if it is a goal
     (if (funcall goal-test (node-state node))
	 (return-from generic-search 
		      (values node nodes-expanded nodes-generated 
			      nodes-pruned)))
     ;; expand node
     (incf nodes-expanded)           ; collect statistics
     (dolist (successor (expand-node successor-func node))
	     (incf nodes-generated)  ; collect statistics
	     ;; if successor is not to be pruned then insert into node store
	     (if (and (not (null pruning-test)) 
		      (funcall pruning-test successor))
		 (incf nodes-pruned) ; collect statistics
	       (funcall node-store-insert successor))))))

;;;
;;; Utility functions for reporting results.
;;;

(defun print-node-path (node)
  "Print out the operator path that generates a node and then return NIL."
  (if (node-parent node)
      (print-node-path (node-parent node)))
  (print (list ':operator (node-depth node) (node-operator node)))
  (print (list ':state    (node-depth node) (node-state    node)))
  nil)

(defun solve-problem (problem strategy)
  "Solve PROBLEM using STRATEGY and then report solution and
performance statistics before returning NIL."
  (multiple-value-bind 
   (node nodes-expanded nodes-generated nodes-pruned)
   (generic-search problem strategy)
   (if (eq node 'failure)
       (print 'failure)
     (progn
       (print-node-path node)
       (print (list ':path-length (node-depth node)))
       (print (list ':path-cost   (node-path-cost node)))))
   (print (list ':number-of-nodes-expanded  nodes-expanded))
   (print (list ':number-of-nodes-generated nodes-generated))
   (print (list ':number-of-nodes-pruned    nodes-pruned))
   nil))