;;;; Iterative Improvement Search Algorithms

(defun between (min max) 
   (+ min  (* (random 1.0) (- max min))))

(defun mutate (current)
  (dolist (part current current)
    (let* ((old (cdr part))
	   (min (expt 10 -30.0))
	   (tmp (max old min))
	   (new (* tmp (between 0.1 2))))
      (setf (cdr  part)  new))))

(defmacro at (key l) `(cdr (assoc ,key ,l)))

(defun start () `((a . 1) (b . 1)))
(defun cost (l) 
  (let ((a (at 'a l))
	(b (at 'b l))) (abs (+ (* 3 a ) (* -1 b) 2))))


(defun metropolis (&key (steps 1000) 
		   (cost 'cost)
		   (next 'mutate) 
		   (first 'start)
		   (near  0.001))
  (let* (best 
	(time 1) 
	(bestS (expt 10 32)) 
	new 
	newS 
	(current (funcall first))
	(currentS (funcall cost current)))
    (loop
     (if (or (<= time 0 )(<= (abs bestS ) near)) 
	 (return (values best bestS)))
     (setf new      (funcall next current)
	   newS     (funcall cost new))
     (if (< newS bestS)
	 (setf best   (copy-list new)
	       bestS  newS))
     (if (accept (- newS currentS) time)
	 (setf current   (copy-list new)
	       currentS  newS))
     (setf time (- time (/ 1.0 steps)))
)))


(defun accept(delta time) 
  (or (<= delta 0)
      (let ((tmp (without-floating-point-underflow 
		  (expt 2.781281828 (* -1.0 (/ delta time))))))
	(or  (not (zerop tmp))
	     (< (random 1.0) 
		tmp)))))