;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; This file is part of "NOVA":  NOVA = search + COCOMO tools
; Copyright, 2008, Tim Menzies tim@menzies.us
;
; NOVA is free software: you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation, either version 3 of the License, or
; (at your option) any later version.
;
; NOVA is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
; GNU General Public License for more details.
; You should have received a copy of the GNU General Public License
; a long with NOVA.  If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defsearch a-star ((stable% 0.25) (g-factor 10) (h-factor 1))
  (save-state)
  (push path paths)
  (let ((best path))

    ;; loop until the best solution stabilizes
    (do ((n 0 (1+ n))
	 (m 0 (1+ m)))
	((or (null paths)
	     (and (>= n 50)
		  (>= (/ m n) stable%))))
      (switch-path (pop paths))

      ;; if the solution is not fully constrained, generate successors
      (unless (= (constrained% (first-state? path)) 1)

	;; pick a random feature
	(let* ((treatment (?elt (coalesce-treatments (non-singletons? open))))
	       (feature   (car treatment))
	       (range     (cdr treatment)))

	  ;; discard ranges one at a time, storing each new path as a successor
	  (dolist (value range)
	    (with-new-path
	      (move-elt (list feature value) open closed)
	      (save-state)

	      ;; score each state by g + h as it is generated
	      (setf (state-score (first-state? path)) (+ (g path g-factor)
							 (h path h-factor)))
	      (push path paths)))))
      (when paths

	;; sort paths by g + h
	(setf paths (sort paths #'< :key #'(lambda (path) (state-score (first-state? path)))))

	;; trim to 1000 paths (avoids using too much memory)
	(if (> (length paths) 1000)
	    (setf paths (subseq paths 0 1000)))
	(if *debug-search* (print-paths (subseq paths 0 (min 5 (length paths))) :which :first)))

      ;; reset m if we have a new minimum energy
      (let ((min-e (min-energy? paths)))
	(if (< (energy? min-e) (energy? (first-state? best)))
	    (setf best (find min-e paths :key #'min-energy? :test #'equal)
		  m    0))))

    ;; switch to the best path
    (switch-path best)))

(defun g (path g-factor)
  "Returns the cost so far."
  (g-transform (constrained% (first-state? path))
	       g-factor))

(defun h (path h-factor)
  "Returns the estimated cost to the goal."
  (h-transform (/ (energy? (first-state? path))
		  (energy? (max-energy?  path)))
	       h-factor))

(defun g-transform (g g-factor)
  "Transforms the raw g value to reduce the cost of imposing additional
   constraints when the number of total constraints is small."
  (expt g g-factor))

(defun h-transform (h h-factor)
  "Transforms the raw h value to enlarge the value of smaller energy
   improvements when the energy is small."
  (expt h (/ 1 h-factor)))