;; -*- Mode: Lisp; -*-

;;; Different search strategies
;;; Last Edited: 1/6/05, KDF

;;; Copyright (c) 1986-1991, Kenneth D. Forbus, Northwestern University,
;;; and Johan de Kleer, the Xerox Corporation.
;;; All rights reserved.

;;; See the file legal.txt for a paragraph stating scope of permission
;;; and disclaimer of warranty.  The above copyright notice and that
;;; paragraph must be included in any separate copy of this file.

(in-package :cl-user)
;;; ----------------------------------------------------------------------------
;; Small variations in BSOLVE suffice to implement a variety of search strategies.

(defun dsolve (initial problem)
  "Perform depth-first search on the problem, using the given start state."
  (do ((queue (list (make-new-path problem initial))
	      ; Small change, large difference!  Now LIFO queue, not FIFO queue.
	      (append new-paths (cdr queue)))
       (current-path nil)  ;; Current path popped from path queue.
       (current-state nil) ;; Current state in current path.
       (new-paths nil)     ;; New paths generated from current state.
       (number-examined 1 (1+ number-examined))) ;; Counter.
      ((null queue))
    (setq current-path (car queue)) ;; Pop path from queue.
    (setq current-state (current-state current-path))
    (when (goal-found? current-state problem)
       (when *debug-cps*
	 (format t "~%Found goal state: ~A" (state->string current-state problem)))
       (return (values current-path number-examined)))
    (setq new-paths (extend-path current-path))
    (when *debug-cps*
      (format t "~%State explored: ~A" (state->string current-state problem))
      (format t "~%New operator instances:")
      (print-new-paths new-paths))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Best-solve

(defun best-solve (initial problem)
   "Best-first search on given problem, starting from initial state."
   (do ((queue 
         (list (make-new-path problem initial
                              (distance-remaining initial problem)))
          ;merge new paths, keeping queue sorted by distance to goal.
          (let ((nqueue (cdr queue))) ;; Path queue sorted by distance. 
             (dolist (path new-paths nqueue)
                (setf (path-distance path) ; estimate distance
                      (distance-remaining (current-state path) problem))
                (setq nqueue ;; Each time, resort queue.
                  (merge 'list (list path) nqueue ; insert in order
                    #'< :key #'(lambda (x) (path-distance x)))))))
       (current-path nil)  ;; Current path.
       (current-state nil) ;; Current state in path.
       (new-paths nil nil) 
       (number-examined 1 (1+ number-examined))) 
      ((null queue))
    (setq current-path (car queue)) ;; Pop path from queue.
    (setq current-state (current-state current-path))
    (when (goal-found? current-state problem)
       (when *debug-cps*
          (format t "~%Found goal state: ~A" (state->string current-state problem)))
       (return (values current-path number-examined)))	
      (setq new-paths (extend-path current-path))
    (when *debug-cps*
      (format t "~%State explored: ~A" (state->string current-state problem))
      (format t "~%New operator instances:")
      (print-new-paths new-paths)))) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Beam solve

(defun beam-solve (initial problem &optional (n 3))
   "Use beam search to solve search problem."
   (do ((queue
          (list (make-new-path problem initial (list initial)))
          (let ((nqueue (cdr queue)))
             (dolist (path new-paths)
                (setf (path-distance path) ; estimate distance
                      (distance-remaining (current-state path) problem))
                (setq nqueue (merge 'list (list path) nqueue ; insert in order
                               #'<
                               :key #'(lambda (x) (path-distance x)))))
             (when (> (length nqueue) n) ;; clips all but first n
                (setf (cdr (nthcdr (1- n) nqueue)) nil))
             nqueue))
        (current-path nil)
        (current-state nil)
        (new-paths nil nil)
        (number-examined 1 (1+ number-examined)))
       ((null queue))
    (setq current-path (car queue))
    (setq current-state (current-state current-path))
    (when (goal-found? current-state problem)
       (when *debug-cps*
          (format t "~%Found goal state: ~A" (state->string current-state problem)))
       (return (values current-path number-examined)))	
    (setq new-paths (extend-path current-path))
    (when *debug-cps*
      (format t "~%State explored: ~A" (state->string current-state problem))
      (format t "~%New operator instances:")
      (print-new-paths new-paths))))