From 2e40d74ece6b33ea48202d7b3e14fe95521cd5ee Mon Sep 17 00:00:00 2001
From: Liam Healy <liam@thinkpad.local>
Date: Thu, 7 May 2009 23:06:55 -0400
Subject: [PATCH] RNG printing, don't assume :slug in defmcallback, simulated
 annealing

Print random number generator instances with type.  Don't assume that
:slug is in the argument list of a defmcallback; make declare ignore
form only if it's there.  Update docstring for +taus2+.  Continued
development of the simulated annealing renovation.
---
 init/callback.lisp       |   5 +-
 random/generators.lisp   |   6 +-
 random/rng-types.lisp    |   4 +-
 simulated-annealing.lisp | 116 ++++++++++++++++++++++++++++++---------
 4 files changed, 99 insertions(+), 32 deletions(-)

diff --git a/init/callback.lisp b/init/callback.lisp
index 7de3a841..3a4ab042 100644
--- a/init/callback.lisp
+++ b/init/callback.lisp
@@ -1,6 +1,6 @@
 ;; Foreign callback functions.               
 ;; Liam Healy 
-;; Time-stamp: <2009-04-04 22:44:06EDT callback.lisp>
+;; Time-stamp: <2009-05-04 21:44:08EDT callback.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -219,5 +219,6 @@
 	 (,@(substitute `(,slug :pointer) :slug args))
        ;; Parameters as C argument are always ignored, because we have
        ;; CL specials to do the same job.
-       (declare (ignore ,slug) (special ,dynamic-variable))
+       (declare ,@(when (member :slug args) `((ignore ,slug)))
+		(special ,dynamic-variable))
        (funcall ,dynamic-variable ,@(mapcar 'st-symbol (remove :slug args))))))
diff --git a/random/generators.lisp b/random/generators.lisp
index 6343edd7..74cd95ac 100644
--- a/random/generators.lisp
+++ b/random/generators.lisp
@@ -1,6 +1,6 @@
 ;; Generators of random numbers.
 ;; Liam Healy, Sat Jul 15 2006 - 14:43
-;; Time-stamp: <2009-02-21 17:23:26EST generators.lisp>
+;; Time-stamp: <2009-05-07 22:42:30EDT generators.lisp>
 ;; $Id$
 
 (in-package :gsl)
@@ -29,6 +29,10 @@
   :initialize-suffix ("set" :void)
   :initialize-args ((value :ulong)))
 
+(defmethod print-object ((object random-number-generator) stream)
+  (print-unreadable-object (object stream :type t :identity t)
+    (format stream "of type ~a" (name object))))
+
 ;;;;****************************************************************************
 ;;;; Seed
 ;;;;****************************************************************************
diff --git a/random/rng-types.lisp b/random/rng-types.lisp
index ec1f2abc..0bb816b7 100644
--- a/random/rng-types.lisp
+++ b/random/rng-types.lisp
@@ -1,6 +1,6 @@
 ;; Random number generation
 ;; Liam Healy, Tue Jul 11 2006 - 23:39
-;; Time-stamp: <2009-02-16 18:49:40EST rng-types.lisp>
+;; Time-stamp: <2009-05-07 22:28:16EDT rng-types.lisp>
 ;; $Id$
 
 ;;; Random number generator types and information functions.
@@ -240,7 +240,7 @@
      described in the paper,
      P. L'Ecuyer, ``Tables of Maximally Equidistributed Combined LFSR
      Generators'', Mathematics of Computation, 68, 225 (1999), 261--269
-     The generator *taus2* should now be used in preference to *taus*.")
+     The generator +taus2+ should now be used in preference to +taus+.")
 
 (def-rng-type +taus113+)
 
diff --git a/simulated-annealing.lisp b/simulated-annealing.lisp
index bf7a932c..acd7043b 100644
--- a/simulated-annealing.lisp
+++ b/simulated-annealing.lisp
@@ -1,10 +1,12 @@
 ;; Simulated Annealing
 ;; Liam Healy Sun Feb 11 2007 - 17:23
-;; Time-stamp: <2009-05-03 18:47:17EDT simulated-annealing.lisp>
+;; Time-stamp: <2009-05-07 23:01:05EDT simulated-annealing.lisp>
 ;; $Id$
 
 (in-package :gsl)
 
+;;; /usr/include/gsl/gsl_siman.h
+
 ;;; 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.
@@ -50,6 +52,91 @@
      ,t-min)
     ,@body))
 
+(defmacro def-energy-function (name)
+  "Define an energy or distance fuction for simulated annealing."
+  `(def-single-function ,name :double :pointer nil))
+
+(defmacro def-step-function (name)
+  "Define a step fuction for simulated annealing."
+  (let ((generator (gensym "GEN"))
+	(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")))
+    `(cffi:defcallback ,name :double
+      ((,x :pointer) (,y :pointer))
+      (,name ,x ,y))))
+
+(defmacro def-print-function (name)
+  "Define a print function for simulated annealing."
+  `(def-single-function ,name :int :pointer nil))
+
+;;;;****************************************************************************
+;;;; Callbacks
+;;;;****************************************************************************
+
+;;; A "state pointer" is in integer with a value of 0, 1, or 2.  The
+;;; users functions must suitably define state and be prepared to keep
+;;; three instances.  When they callbacks are called they will be
+;;; directed to do certain operations on one (or two) of the three
+;;; states.
+
+(defun state-pointer (foreign-pointer)
+  (cffi:pointer-address (cffi:mem-aref foreign-pointer :pointer)))
+
+;;; The user-energy-function should take one state pointers, and
+;;; return a double-float.
+;;; typedef double (*gsl_siman_Efunc_t) (void *xp);
+(cffi:defcallback sa-energy-function :double ((state :pointer))
+  (declare (special user-energy-function))
+  (funcall user-energy-function (state-pointer state)))
+
+;;; The user-step-function should take a rng pointer, a state pointer,
+;;; and a double-float, and return nothing.  The rng pointer should be
+;;; used in call to one of the distribution functions like #'uniform.
+;;; typedef void (*gsl_siman_step_t) (const gsl_rng *r, void *xp, double step_size);
+(cffi:defcallback sa-step-function :void
+    ((rng :pointer) (state :pointer) (step-size :double))
+  (declare (special user-step-function))
+  (funcall user-step-function rng (state-pointer state) step-size))
+
+;;; typedef double (*gsl_siman_metric_t) (void *xp, void *yp);
+;;; typedef void (*gsl_siman_print_t) (void *xp);
+
+;;; The user-copy-function should take two state pointers, and return nothing.
+;;; typedef void (*gsl_siman_copy_t) (void *source, void *dest);
+(cffi:defcallback sa-copy-function :void ((source :pointer) (destination :pointer))
+  (declare (special user-copy-function))
+  (funcall user-copy-function
+	   (state-pointer source)
+	   (state-pointer destination)))
+
+;;; The copy constructor will be special.  It will only be called
+;;; three times in the run, and it will generate in succession the
+;;; three pointer values.  It should expect copy state from the
+;;; supplied value.
+(cffi:defcallback sa-copy-constructor-function :pointer ((state :pointer))
+  )
+
+
+;;; typedef void * (*gsl_siman_copy_construct_t) (void *xp);
+
+#|
+typedef void (*gsl_siman_destroy_t) (void *xp);
+|#
+
+
+
+;;;;****************************************************************************
+;;;; New
+;;;;****************************************************************************
+
 (defmfun simulated-annealing
     (generator x0-p
 	       Ef take-step distance-function
@@ -58,7 +145,7 @@
 	       element-size parameters)
   "gsl_siman_solve"
   (((mpointer generator) :pointer) (x0-p :pointer)
-   ((cffi:get-callback Ef) :pointer)
+   ((cffi:get-callback simulated-annealing-energy) :pointer)
    ((cffi:get-callback take-step) :pointer)
    ((cffi:get-callback distance-function) :pointer)
    ((cffi:get-callback print-position) :pointer)
@@ -103,31 +190,6 @@
    The simulated annealing routines require several user-specified
    functions to define the configuration space and energy function.")
 
-(defmacro def-energy-function (name)
-  "Define an energy or distance fuction for simulated annealing."
-  `(def-single-function ,name :double :pointer nil))
-
-(defmacro def-step-function (name)
-  "Define a step fuction for simulated annealing."
-  (let ((generator (gensym "GEN"))
-	(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")))
-    `(cffi:defcallback ,name :double
-      ((,x :pointer) (,y :pointer))
-      (,name ,x ,y))))
-
-(defmacro def-print-function (name)
-  "Define a print function for simulated annealing."
-  `(def-single-function ,name :int :pointer nil))
-
 ;;;;****************************************************************************
 ;;;; Example
 ;;;;****************************************************************************
-- 
GitLab