;;;
;;; A collection of search strategies
;;;
;;; By Philip W. L. Fong
;;;

;;
;; Cycle checking
;;

(defun cycle-aux-p (node state)
  "Search if STATE appears in the path generating NODE."
  (if (null node)
      nil
    (or (equal (node-state node) state)
	(cycle-aux-p (node-parent node) state))))

(defun cycle-p (node)
  "Check if NODE is generated by a cyclic path."
  (and (not (null node))
       (cycle-aux-p (node-parent node) (node-state node))))

;;
;; Depth-First Search
;;

(defun make-dfs (depth-limit &optional (pruning-test #'cycle-p))
  "The modified mysterious strategy, now allowing users to supply an
optional pruning test predicate.  The default pruning test is cycle
detection.  To turn off pruning, pass in NIL as the pruning test
predicate."
  (let
      ((node-store nil))
    (make-strategy
     ;; node-store-insert
     #'(lambda (node)
	 (setf node-store (cons node node-store)))
     ;; node-store-remove
     #'(lambda ()
	 (let ((node (first node-store)))
	   (setf node-store (rest node-store))
	   node))
     ;; node-store-empty-p
     #'(lambda ()
	 (null node-store))
     ;; pruning-test
     #'(lambda (node)
	 (or (> (node-depth node) depth-limit)
	     (and (not (null pruning-test)) 
		  (funcall pruning-test node)))))))

;;
;; A* strategy
;;

(defun make-A* (h &optional (pruning-test #'cycle-p))
  "Return an A* search strategy, with H as heuristic function and
PRUNING-TEST as the pruning test predicate.  (Both H and PRUNNING-TEST
take search nodes as arguments)."
  (let
      ((node-store (make-priority-queue)))
    (make-strategy
     ;; node-store-insert
     (lambda (node)
       (setf node-store (priority-queue-insert node-store 
					       node 
					       (+ (node-path-cost node) 
						  (funcall h node)))))
     ;; node-store-remove
     (lambda ()
       (let ((node (priority-queue-top node-store)))
	 (setf node-store (priority-queue-remove node-store))
	 node))
     ;; node-store-empty-p
     (lambda () 
       (priority-queue-empty-p node-store))
     ;; pruning-test
     pruning-test)))