;;;
;;; 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))