;;;; Iterative Improvement Search Algorithms

;;; Currently these do not do repeated-state checking.  Each takes a problem
;;; and returns two values: like all search algorithms, the first is a
;;; solution node or nil, but the second value will be the best node found
;;; so far, even if it is not a solution.  We will assume that all
;;; evaluations are costs (i.e., we're seeking minima).

;;;; Top Level Functions

(defun hill-climbing-search (problem 
			     &optional (stopping-criterion #'minimum-or-flat))
  "Search by picking the best successor according to heuristic h.
  Stops according to stopping-criterion."
  (let ((current (create-start-node problem))
	next)
    (loop
     (let ((successors (expand current problem)))
       (when successors
	 (setf next (the-smallest-random-tie #'node-h-cost successors)))
       (when (or (null successors)
		 (funcall stopping-criterion current next))
	 (return (values (goal-test problem current) current)))
       (setf current next)))))

(defun simulated-annealing-search (problem &optional
					   (schedule (make-exp-schedule)))
  "Like hill-climbing-search, except that we pick a next node randomly;
  if it is better, or if the badness of the next node is small and the
  'temperature' is large, then we accpet it, otherwise we ignore it.
  We halt when the temperature, TEMP, hits zero [p 113]."
  ;; Unlike [p 113], we keep track of successors to avoid generating them twice.
  ;; Also, we return the best node, rather than the current node
  (let* ((current (create-start-node problem))
	 (successors (expand current problem))
	 (best current)
	 next temp delta)
    (for time = 1 to infinity do
	 (setf temp (funcall schedule time))
	 (when (or (= temp 0) (null successors))
	   (RETURN (values (goal-test problem best) best)))
	 (when (< (node-h-cost current) (node-h-cost best))
	   (setf best current))
	 (setf next (random-element successors))
	 (setf delta (- (node-h-cost next) (node-h-cost current)))
	 (when (or (< delta 0.0) ; < because we are minimizing
		   (< (random 1.0) (exp (/ (- delta) temp))))
	   (setf current next
		 successors (expand next problem))))))

(defun random-restart-search (problem-fn &optional (n 10))
  "Random-restart hill-climbing repeatedly calls hill-climbing-search.
  PROBLEM-FN should return a problem with a random initial state.
  We look at N different initial states, and keep the best solution found."
  (let ((best-node nil))
    (for i = 1 to n do
	 (multiple-value-bind (solution node)
	     (hill-climbing-search (funcall problem-fn))
	   (declare (ignore solution))
	   (when (or (null best-node)
		     (< (node-h-cost node) (node-h-cost best-node)))
	     (setf best-node node))))
    best-node))

(defun hill-climbing-until-flat-n-times-search (problem &optional (n 4))
  "Do hill climbing, but stop after no improvement N times in a row."
  (hill-climbing-search problem (minimum-or-flat-n-times n)))

;;;; Auxiliary Functions

(defun local-minimum (current next)
  "Stop when the next state is worse than the current."
  (> (node-h-cost next) (node-h-cost current)))

(defun minimum-or-flat (current next)
  "Stop when the next state is no better than the current."
  (>= (node-h-cost next) (node-h-cost current)))

(defun minimum-or-flat-n-times (n)
  "Return a function that stops when no improvement is made N times in a row."
  (let ((times-in-a-row 0))
    #'(lambda (current next)
	(cond ((< (node-h-cost next) (node-h-cost current))
	       (setf times-in-a-row 0)
	       nil)
	      ((>= (incf times-in-a-row) n))))))

(defun CSP-termination (current next)
  (declare (ignore next))
  (CSP-goalp (node-state current)))

(defun make-exp-schedule (&key (k 20) (lambda 0.005) (limit 100))
  "Return an exponential schedule function with time limit."
  #'(lambda (time) (if (< time limit)
		       (* k (exp (- (* lambda time))))
		     0)))