;;;; Search Engines
;;;;
;;;; File:         search.lsp

;; Variables to gather statistics on searches.
;;
(defvar *trace* nil)	; True to trace.
(defvar *visits*)	; Number of state visits.
(defvar *limit* 100)	; Limit on number of state

;; Given a value and a header, princ the header and
;; prin1 the value, all on a fresh line.  Then return
;; the value.
;;
(defun trace-value (header value)
  (cond (*trace*
	 (fresh-line)
	 (princ header) (prin1 value) (fresh-line))))


;; (search-time e) evaluates e and prints timing
;; statistics on its execution.  These include the
;; number of state visits made.  The result of
;; evaluating e is returned.
;;
(defmacro search-time (e)
  `(let ((result nil))
    (setf result (time ,e))
    (fresh-line)
    (terpri)
    (princ '|Number of States Visited: |)
    (princ *visits*)
    (terpri)
    (terpri)
    result))



;; Abstract interface to state-oriented search.
;;
;;	state ::= s-expression
;;
;; (children 's 'seen) ===> <list of (unseen) children
;;				  of state s>
;;			     where `seen' is the list of
;;			     already seen states
;;			     (including s)
;;				
;; (goal 's) ===> T if state s is the goal state,
;;		  NIL if not
;;
;;
;; The CHILDREN and GOAL functions define the state data
;; abstraction.

;; Function to make a list of paths from a list of
;; states and a single path, by putting each state in
;; the state list at the beginning of the single path.
;;
(defun mappush (state-list path)
  (mapcar #'(lambda (state) (cons state path))
	  state-list))

;; Breadth first search.
;;
;; (breadth-first-search 'start-state-list
;;			 #'children #'goal)
;;
;;	===> <path to goal> if success
;;
;;	===> NIL if failure
;;
;;      ===> '|Limit Reached, Giving Up|
;;		if number-of-state-visits >= *limit*
;;
(defun breadth-first-search
	  (start-state-list children goal)
  (setf *visits* 0)
  (breadth-first-search-recurse
   (mappush start-state-list nil)
   start-state-list
   children goal))

;; In the following, instead of using a list of
;; starting states, a list of paths to starting states
;; is used, so we can keep track of the path to each
;; state.
;;
;; RR: (breadth-first-search-recurse
;;	       '() 'seen #'children #'goal)
;;	   ===> nil
;;     (breadth-first-search-recurse
;;	       '((state . more-states) . more-paths)
;;	       'seen #'children #'goal)
;;	   ===> '(state . more-states)
;;			if (funcall #'goal state)
;;				===> true
;;	   ===> (breadth-first-search-recurse
;;		  (append 'more-paths
;;			  (mappush
;;			    'new-states
;;			    '(state .  more-states)))
;;		  (append 'seen 'new-states))
;;			if none of the above apply,
;;		      where
;;		      (funcall #'children 'state 'seen)
;;			  ===> 'new-states
;;

(defun breadth-first-search-recurse
            (path-list seen children goal)
  (cond
   ((null path-list) nil)
   (t
    (let* ((current-path (first path-list))
	   (current-state (first current-path)))

     (trace-value '|Processing State: | current-state)
     (setf *visits* (+ *visits* 1))

     (cond

      ((funcall goal current-state)
       current-path)

      ((>= *visits* *limit*)
       '|Limit Reached, Giving Up|)

      (t
       (let ((new-states
	      (funcall children current-state seen)))

	(trace-value '|New States: | new-states)

	(breadth-first-search-recurse
	 (append (rest path-list)
		 (mappush new-states current-path))
	 (append seen new-states)
	 children goal))))))))

;; Depth first search.
;;
;; (depth-first-search 'start-state-list
;;		       #'children #'goal)
;;
;;	===> <path to goal> if success
;;
;;	===> NIL if failure
;;
;;      ===> '|Limit Reached, Giving Up|
;;		if number-of-state-visits >= *limit*
;;
(defun depth-first-search
	  (start-state-list children goal)
  (setf *visits* 0)
  (depth-first-search-recurse
   (mappush start-state-list nil)
   start-state-list
   children goal))

;; Just like breadth-first-search but new paths
;; are put in front of old paths.
;;
(defun depth-first-search-recurse
	  (path-list seen children goal)
  (cond

   ((null path-list) nil)

   (t
    (let* ((current-path (first path-list))
	   (current-state (first current-path)))

     (trace-value '|Processing State: | current-state)
     (setf *visits* (+ *visits* 1))

     (cond

      ((funcall goal current-state)
       current-path)

      ((>= *visits* *limit*)
       '|Limit Reached, Giving Up|)

      (t
       (let ((new-states
	      (funcall children current-state seen)))

	(trace-value '|New States: | new-states)

	(depth-first-search-recurse
	 (append (mappush new-states current-path)
		 (rest path-list))
	 (append seen new-states)
	 children goal))))))))

;; Random search.
;;
;; (random-search 'start-state-list #'children #'goal)
;;
;;	===> <path to goal> if success
;;
;;	===> NIL if failure
;;
;;      ===> '|Limit Reached, Giving Up|
;;		if number-of-state-visits >= *limit*
;;
(defun random-search (start-state-list children goal)
  (setf *visits* 0)
  (random-search-recurse
   start-state-list nil children goal))

;; RR: (random-search-recurse
;;             '() 'path #'children #'goal)
;;         ===> nil
;;     (random-search-recurse
;;             '(state . more-states) 'path
;;	       #'children #'goal)
;;         ===> '(current-state . path)
;;		    if (funcall #'goal 'current-state)
;;				===> true
;;         ===> (random-search-recurse
;;		  (funcall #'children 'current-state
;;			   (cons 'current-state 'path))
;;		  (cons 'current-state 'path)
;;		  #'children #'goal)
;;		    otherwise
;;	   where (random-element '(state . more-states))
;;			===> current-state
;;

(defun random-search-recurse
	  (state-list path children goal)

  (cond

   ((null state-list)
    nil)

   (t
    (let ((current-state (random-element state-list)))
	 
     (trace-value '|Processing State: | current-state)
     (setf *visits* (+ *visits* 1))
	 
     (cond
      
      ((funcall goal current-state)
       (cons current-state path))
      
      ((>= *visits* *limit*)
       '|Limit Reached, Giving Up|)
      
      (t
       (let ((new-states
	      (funcall children current-state
		       (cons current-state path))))
	    
	(trace-value '|New States: | new-states)
	    
	(random-search-recurse new-states
			       (cons current-state path)
			       children goal))))))))

;; Return a random member of a list.  The list must not
;; be of zero length.
;;
(defun random-element (list)
  (let* ((length (length list))
	 (index (random length)))
	(nth index list)))