simulated-annealing.lisp 6.65 KB
Newer Older
liam's avatar
liam committed
1 2
;; Simulated Annealing
;; Liam Healy Sun Feb 11 2007 - 17:23
Liam Healy's avatar
Liam Healy committed
3
;; Time-stamp: <2009-01-12 22:48:38EST simulated-annealing.lisp>
lhealy's avatar
lhealy committed
4
;; $Id$
5 6 7

(in-package :gsl)

8 9 10 11
;;; This does not work.
;;; Step size passed to the step function is incorrect.
;;; Print function is ignored, but probably couldn't work if it weren't.
;;; Does not converge.
12 13 14 15 16 17 18 19 20 21 22 23


(cffi:defcstruct simulated-annealing-parameters
  (n-tries :int)		; how many points to try for each step
  (iterations-fixed-T :int) ; how many iterations at each temperature?
  (step-size :double)		    ; max step size in the random walk
  ;; The following parameters are for the Boltzmann distribution
  (k :double)
  (t-initial :double)
  (mu-t :double)
  (t-min :double))

24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
(defmacro with-simulated-annealing-parameters
    ((name number-of-tries iterations-per-temperature
		      step-size &optional k t-initial mu-t t-min)
     &body body)
  `(cffi:with-foreign-object (,name 'simulated-annealing-parameters)
    (setf
     (cffi:foreign-slot-value
      ,name 'simulated-annealing-parameters 'n-tries)
     ,number-of-tries
     (cffi:foreign-slot-value
      ,name 'simulated-annealing-parameters 'iterations-fixed-T)
     ,iterations-per-temperature
     (cffi:foreign-slot-value
      ,name 'simulated-annealing-parameters 'step-size)
     ,step-size
     ;; The following parameters are for the Boltzmann distribution
     (cffi:foreign-slot-value
      ,name 'simulated-annealing-parameters 'k)
     ,k
     (cffi:foreign-slot-value
      ,name 'simulated-annealing-parameters 't-initial)
     ,t-initial
     (cffi:foreign-slot-value
      ,name 'simulated-annealing-parameters 'mu-t)
     ,mu-t
     (cffi:foreign-slot-value
      ,name 'simulated-annealing-parameters 't-min)
     ,t-min)
    ,@body))

liam's avatar
liam committed
54
(defmfun simulated-annealing
55 56 57 58 59 60
    (generator x0-p
	       Ef take-step distance-function
	        print-position
		;; copy-function copy-constructor destructor
	       element-size parameters)
  "gsl_siman_solve"
61
  (((mpointer generator) :pointer) (x0-p :pointer)
62 63 64 65 66 67 68 69 70 71
   ((cffi:get-callback Ef) :pointer)
   ((cffi:get-callback take-step) :pointer)
   ((cffi:get-callback distance-function) :pointer)
   ((cffi:get-callback print-position) :pointer)
   ((cffi:null-pointer) :pointer)
   ((cffi:null-pointer) :pointer)
   ((cffi:null-pointer) :pointer)
   ;;((cffi:get-callback copy-function) :pointer)
   ;;((cffi:get-callback copy-constructor) :pointer)
   ;;((cffi:get-callback destructor) :pointer)
Liam Healy's avatar
Liam Healy committed
72
   (element-size sizet) (parameters simulated-annealing-parameters))
73
  :c-return :void
liam's avatar
liam committed
74
  :documentation			; FDL
75
  "Perform a simulated annealing search through a given
liam's avatar
liam committed
76 77 78
   space.  The space is specified by providing the functions Ef and
   distance.  The simulated annealing steps are generated using the
   random number generator r and the function take-step.
79 80 81 82 83 84 85 86 87 88

   The starting configuration of the system should be given by x0-p
   The routine offers two modes for updating configurations, a fixed-size
   mode and a variable-size mode.  In the fixed-size mode the configuration
   is stored as a single block of memory of size element-size
   The functions copy-function,
   copy-constructor and destructor should be NIL in
   fixed-size mode.  In the variable-size mode the functions
   copy-function, copy-constructor and destructor are used to
   create, copy and destroy configurations internally.  The variable
liam's avatar
liam committed
89
   element-size should be zero in the variable-size mode.
90 91 92 93 94 95 96 97 98

   The parameters structure (described below) controls the run by
   providing the temperature schedule and other tunable parameters to the
   algorithm.

   On exit the best result achieved during the search is placed in
   x0-p.  If the annealing process has been successful this
   should be a good approximation to the optimal point in the space.

liam's avatar
liam committed
99 100
   If the function pointer print-position is not null, a debugging
   log will be printed to standard output with the following columns:
101
   number_of_iterations temperature x x-x0p Ef(x)
liam's avatar
liam committed
102 103
   and the output of the function print-position itself.  If
   print-position is null then no information is printed.
104 105 106
   The simulated annealing routines require several user-specified
   functions to define the configuration space and energy function.")

107 108
(defmacro def-energy-function (name)
  "Define an energy or distance fuction for simulated annealing."
liam's avatar
liam committed
109
  `(def-single-function ,name :double :pointer nil))
110 111 112

(defmacro def-step-function (name)
  "Define a step fuction for simulated annealing."
Liam Healy's avatar
Liam Healy committed
113
  (let ((generator (gensym "GEN"))
114 115 116 117 118 119 120 121 122 123
	(arguments (gensym "ARGS"))
	(step-size (gensym "SS")))
    `(cffi:defcallback ,name :void
      ((,generator :pointer) (,arguments :pointer) (,step-size :double))
      (,name ,generator ,arguments ,step-size))))

(defmacro def-distance-function (name)
  "Define a metric distance fuction for simulated annealing."
  (let ((x (gensym "X"))
	(y (gensym "Y")))
124
    `(cffi:defcallback ,name :double
125 126 127 128 129
      ((,x :pointer) (,y :pointer))
      (,name ,x ,y))))

(defmacro def-print-function (name)
  "Define a print function for simulated annealing."
liam's avatar
liam committed
130
  `(def-single-function ,name :int :pointer nil))
131 132 133 134 135 136 137 138 139 140 141 142 143

;;;;****************************************************************************
;;;; Example
;;;;****************************************************************************

;;; Trivial example, Sec. 24.3.1
;;; This does not work.

(defun M2 (cx cy)
  (with-c-double (cx x)
    (with-c-double (cy y)
      (abs (- x y)))))

144 145
(defvar *sa-function-calls*)

146 147 148 149 150
(defun E2 (arg)
  (with-c-double (arg x)
    (incf *sa-function-calls*)
    (when (> *sa-function-calls* 100)
      (error "too much"))
151 152
    (* (exp (- (expt (1- x) 2))) (sin (* 8 x)))))

153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
(defun S2 (generator parameters step-size)
  (with-c-double (parameters x)
    ;;(format t "~&~d ~d" x step-size)
    (let ((step-size 10.0d0))		; this is coming in wrong, so we fix it
      (let ((rand (uniform generator)))
	(setf x (+ x (- (* 2 rand step-size) step-size)))))))

(defparameter *sa-example-print* nil)

;;; Print functions are a problem because it is likely that the C
;;; stdout and the CL *standard-output* are not the same stream.
;;; Also, it seems to ignore that a function is supplied, and avoids
;;; printing anything.
(defun P2 (arg)
  (with-c-double (arg x)
    (when *sa-example-print*
      (format T "~&from P2: ~a" x))))

(def-energy-function E2)
(def-distance-function M2)
(def-step-function S2)
(def-print-function P2)
175 176

(defun simulated-annealing-example ()
177 178 179
  (let ((*sa-function-calls* 0))
    (rng-environment-setup)
    (cffi:with-foreign-object (initial :double)
180
      (setf (dcref initial) 15.5d0)
181 182 183
      (with-simulated-annealing-parameters
	  (params 200 10 10.0d0 1.0d0 0.002d0 1.005d0 2.0d-6)
	(simulated-annealing
Liam Healy's avatar
Liam Healy committed
184
	 (make-random-number-generator *mt19937* 0) initial
185 186 187
	 'E2 'S2 'M2 'P2
	 (cffi:foreign-type-size :double)
	 params)))))
188