Commit 9a099f40 authored by liam's avatar liam

Define letm macro for allocating, setting, and freeing GSL objects.

Replaces with-gsl-object and allows the lambda list to be something
other than the concatenation of the allocation and setting lambda
lists.


git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3279 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
parent c72f51dd
;; Chebyshev Approximations
;; Liam Healy Sat Nov 17 2007 - 20:36
;; Time-stamp: <2008-01-26 18:17:32EST chebyshev.lisp>
;; Time-stamp: <2008-02-02 19:13:03EST chebyshev.lisp>
;; $Id: $
(in-package :gsl)
......@@ -9,14 +9,15 @@
;;;; Creation and calculation of Chebyshev series
;;;;****************************************************************************
(set-asf chebyshev allocate-chebyshev free-chebyshev initialize-chebyshev)
(set-asf (chebyshev order function lower-limit upper-limit)
allocate-chebyshev free-chebyshev initialize-chebyshev)
(defun-gsl allocate-chebyshev (order)
"gsl_cheb_alloc"
((order :size))
:c-return :pointer
:export nil
:index (with-gsl-objects chebyshev)
:index (letm chebyshev)
:documentation
"Allocate a Chebyshev series of specified order
and return a pointer to it.")
......@@ -26,7 +27,7 @@
((chebyshev :pointer))
:c-return :void
:export nil
:index (with-gsl-objects chebyshev)
:index (letm chebyshev)
:documentation
"Free a previously allocated Chebyshev series.")
......@@ -35,7 +36,7 @@
((chebyshev :pointer) (function :pointer)
(lower-limit :double) (upper-limit :double))
:export nil
:index (with-gsl-objects chebyshev)
:index (letm chebyshev)
:documentation
"Compute the Chebyshev approximation for the function over the range
(lower-limit, upper-limit) to the previously specified order. The
......@@ -125,7 +126,7 @@
(defun chebyshev-table-example ()
(let ((steps 100))
(with-gsl-objects ((chebyshev cheb 40 chebyshev-step 0.0d0 1.0d0))
(letm ((cheb (chebyshev 40 chebyshev-step 0.0d0 1.0d0)))
(dotimes (i steps)
(let ((x (coerce (/ i steps) 'double-float)))
(format t "~&~a ~a ~a ~a"
......@@ -136,10 +137,9 @@
(defun chebyshev-point-example (x)
(check-type x double-float)
(with-gsl-objects
((chebyshev cheb 40 chebyshev-step 0.0d0 1.0d0)
(chebyshev deriv 40)
(chebyshev integ 40))
(letm ((cheb (chebyshev 40 chebyshev-step 0.0d0 1.0d0))
(deriv (chebyshev 40))
(integ (chebyshev 40)))
(derivative-chebyshev deriv cheb)
(integral-chebyshev integ cheb)
(list
......
;; Using GSL storage.
;; Liam Healy, Sun Mar 26 2006 - 16:32
;; Time-stamp: <2008-01-27 18:50:53EST data.lisp>
;; Time-stamp: <2008-02-02 23:15:39EST data.lisp>
;; $Id: $
(in-package :gsl)
......@@ -103,6 +103,18 @@
;;(LONG-DOUBLE . "_long_double")
(COMPLEX . "_complex")))
(defmacro data-letm (type)
"Define the letm function for data types."
`(defun-letm ,type (size-or-initial &optional zero)
(let ((argsymb (gensym "ARG")))
(list
`(make-data ',',type ,zero
(if (numberp ,argsymb) ,argsymb (length ,argsymb)))
'free
(lambda (symb)
`(unless (numberp ,argsymb) (setf (data ,symb) ,argsymb)))
(lambda () (list argsymb size-or-initial))))))
(defmacro defdata
(c-string cl-symbol cl-base-type
&optional (superclass 'gsl-data) (dimensions 1))
......@@ -115,40 +127,41 @@
(flet ((gsl-name (function-name)
(format nil "gsl_~a_~a" c-string function-name)))
(let* ((cargs (loop for i below dimensions
collect `((nth ,i (storage-size object)) :size)))
collect `((nth ,i (storage-size object)) :size)))
(object-name (make-symbol-from-strings *gsl-prefix* cl-symbol)))
`(progn
(defclass ,object-name (,superclass)
((cl-base-type :initform ',cl-base-type :reader cl-base-type
:allocation :class)))
(defun-gsl alloc ((object ,object-name))
,(gsl-name "alloc") ,cargs
:type :method
:c-return (cr :pointer)
:return ((assign-pointer object cr)))
(defun-gsl calloc ((object ,object-name))
,(gsl-name "calloc") ,cargs
:type :method
:c-return (cr :pointer)
:return ((assign-pointer object cr)))
(defun-gsl free ((object ,object-name))
,(gsl-name "free") (((pointer object) :pointer))
:type :method
:c-return :void)
(defun-gsl write-binary ((object ,object-name) stream)
,(gsl-name "fwrite") ((stream :pointer) ((pointer object) :pointer))
:type :method)
(defun-gsl read-binary ((object ,object-name) stream)
,(gsl-name "fread") ((stream :pointer) ((pointer object) :pointer))
:type :method)
(defun-gsl write-formatted ((object ,object-name) stream format)
,(gsl-name "fprintf")
((stream :pointer) ((pointer object) :pointer) (format :string))
:type :method)
(defun-gsl read-formatted ((object ,object-name) stream format)
,(gsl-name "fscanf")
((stream :pointer) ((pointer object) :pointer) (format :string))
:type :method)))))
(data-letm ,cl-symbol)
(defclass ,object-name (,superclass)
((cl-base-type :initform ',cl-base-type :reader cl-base-type
:allocation :class)))
(defun-gsl alloc ((object ,object-name))
,(gsl-name "alloc") ,cargs
:type :method
:c-return (cr :pointer)
:return ((assign-pointer object cr)))
(defun-gsl calloc ((object ,object-name))
,(gsl-name "calloc") ,cargs
:type :method
:c-return (cr :pointer)
:return ((assign-pointer object cr)))
(defun-gsl free ((object ,object-name))
,(gsl-name "free") (((pointer object) :pointer))
:type :method
:c-return :void)
(defun-gsl write-binary ((object ,object-name) stream)
,(gsl-name "fwrite") ((stream :pointer) ((pointer object) :pointer))
:type :method)
(defun-gsl read-binary ((object ,object-name) stream)
,(gsl-name "fread") ((stream :pointer) ((pointer object) :pointer))
:type :method)
(defun-gsl write-formatted ((object ,object-name) stream format)
,(gsl-name "fprintf")
((stream :pointer) ((pointer object) :pointer) (format :string))
:type :method)
(defun-gsl read-formatted ((object ,object-name) stream format)
,(gsl-name "fscanf")
((stream :pointer) ((pointer object) :pointer) (format :string))
:type :method)))))
(defun splice-name (base-name keyword symbol)
"Make a new C name for a data function from a base name."
......@@ -198,8 +211,6 @@
(export '(make-data with-data))
(set-asf generic make-data free (setf data) 3)
(defgeneric alloc (object)
(:documentation "Allocate GSL data; used internally."))
......
;; Vectors
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2008-01-26 22:20:43EST vector.lisp>
;; Time-stamp: <2008-02-02 23:13:54EST vector.lisp>
;; $Id: $
(in-package :gsl)
......@@ -469,11 +469,15 @@ same length.")
(setf (data vec) #(-3.21d0 1.0d0 12.8d0))
(data vec))
(with-gsl-objects ((generic vec 'vector-double nil 3))
(letm ((vec (vector-double 3)))
(setf (data vec) #(-3.21d0 1.0d0 12.8d0))
(data vec))
(letm ((vec (vector-double #(-3.21d0 1.0d0 12.8d0))))
(data vec))
(letm ((vec (vector-double '(-3.21d0 1.0d0 12.8d0))))
(data vec))
......
;; Eigenvectors and eigenvalues
;; Liam Healy, Sun May 21 2006 - 19:52
;; Time-stamp: <2008-01-27 18:53:17EST eigensystems.lisp>
;; Time-stamp: <2008-02-02 21:08:35EST eigensystems.lisp>
;; $Id: $
(in-package :gsl)
......@@ -9,13 +9,13 @@
;;;; Real Symmetric Matrices
;;;;****************************************************************************
(set-asf eigen-symm eigen-symm-alloc eigen-symm-free)
(set-asf (eigen-symm n) eigen-symm-alloc eigen-symm-free)
(defun-gsl eigen-symm-alloc (n)
"gsl_eigen_symm_alloc" ((n :size))
:c-return :pointer
:export nil
:index '(with-gsl-objects eigen-symm)
:index '(letm eigen-symm)
:documentation ; FDL
"Allocate a workspace for computing eigenvalues of
n-by-n real symmetric matrices. The size of the workspace
......@@ -25,17 +25,17 @@
"gsl_eigen_symm_free" ((w :pointer))
:c-return :void
:export nil
:index '(with-gsl-objects eigen-symm)
:index '(letm eigen-symm)
:documentation ; FDL
"Free the memory associated with the workspace w.")
(set-asf eigen-symmv eigen-symmv-alloc eigen-symmv-free)
(set-asf (eigen-symmv n) eigen-symmv-alloc eigen-symmv-free)
(defun-gsl eigen-symmv-alloc (n)
"gsl_eigen_symmv_alloc" ((n :size))
:c-return :pointer
:export nil
:index '(with-gsl-objects eigen-symmv)
:index '(letm eigen-symmv)
:documentation ; FDL
"Allocate a workspace for computing eigenvalues and
eigenvectors of n-by-n real symmetric matrices. The size of
......@@ -43,7 +43,7 @@
(defun-gsl eigen-symmv-free (w)
"gsl_eigen_symmv_free" ((w :pointer))
:index '(with-gsl-objects eigen-symmv)
:index '(letm eigen-symmv)
:c-return :void
:documentation ; FDL
"Free the memory associated with the workspace w.")
......@@ -82,7 +82,7 @@
;;;; Complex Hermitian Matrices
;;;;****************************************************************************
(set-asf eigen-herm eigen-herm-alloc eigen-herm-free)
(set-asf (eigen-herm n) eigen-herm-alloc eigen-herm-free)
(defun-gsl eigen-herm-alloc (n)
"gsl_eigen_herm_alloc" ((n :size))
......@@ -112,7 +112,7 @@
:invalidate (eval A)
:return (eval))
(set-asf eigen-hermv eigen-hermv-alloc eigen-hermv-free)
(set-asf (eigen-hermv n) eigen-hermv-alloc eigen-hermv-free)
(defun-gsl eigen-hermv-alloc (n)
"gsl_eigen_hermv_alloc" ((n :size))
......@@ -191,7 +191,7 @@
(0.0d0 0.0d0 40.0d0)))
(with-data (evecs matrix-double (3 3))
(with-data (evals vector-double 3)
(with-gsl-objects ((eigen-symmv ws 3))
(letm ((ws (eigen-symmv 3)))
(eigenvalues-eigenvectors-symmetric mat evals evecs ws)
(values (data evals) (data evecs)))))))
......
;; Discrete Hankel Transforms.
;; Liam Healy, Sat Dec 8 2007 - 16:50
;; Time-stamp: <2008-01-26 18:36:00EST hankel.lisp>
;; Time-stamp: <2008-02-02 19:24:27EST hankel.lisp>
;; $Id: $
(in-package :gsl)
;;; Everything compiles, but not tested -- need example.
(set-asf hankel allocate-hankel free-hankel init-hankel)
(set-asf (hankel size nu xmax) allocate-hankel free-hankel init-hankel)
(defun-gsl allocate-hankel (size)
"gsl_dht_alloc"
((size :size))
:c-return :pointer
:export nil
:index (with-gsl-objects hankel)
:index (letm hankel)
:documentation
"Allocate a Discrete Hankel transform object of size @var{size}.")
......@@ -22,7 +22,7 @@
"gsl_dht_new"
((hankel :pointer) (nu :double) (xmax :double))
:export nil
:index (with-gsl-objects hankel)
:index (letm hankel)
:documentation
"Initialize the transform @var{t} for the given values of
@var{nu} and @var{x}.")
......@@ -44,7 +44,7 @@
((hankel :pointer))
:c-return :void
:export nil
:index (with-gsl-objects hankel)
:index (letm hankel)
:documentation
"Free the Hankel object.")
......
;; Utility definitions
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-01-27 13:28:29EST utility.lisp>
;; Time-stamp: <2008-02-02 22:48:23EST utility.lisp>
;; $Id: $
(in-package :gsl)
......@@ -11,86 +11,91 @@
(defparameter *gsl-prefix* 'gsl)
(defparameter *gsl-objects* nil)
(defstruct gsl-object name allocate free set num-alloc-args)
(defmacro set-asf (name allocate free &optional set (num-alloc-args 1))
"Define an expansion of this name in #'with-gsl-objects
and use the appropriate functions for allocating, freeing, and setting."
;;;;;;;;;;;; GSL objects
;;; Each object has a defun named after it. This function is used
;;; only internally by #'letm, but it is exported so that
;;; arglist prompters such as slime's will show the arguments
;;; needed.
(defparameter *letm-expanded-object* nil)
(defvar *not-for-users* nil)
(defmacro letm (bindings &body body)
(let* (setters ; save setting forms
freers ; save freeing forms
assigns ; save global assignements
(*not-for-users* t)
(bnd ; rewrite the bindings with allocators
(mapcar
(lambda (b)
(let ((defsymb (first b)) (defas (second b)))
(if (and (listp b) (listp defas)
(member (first defas) *letm-expanded-object*))
;; It is a GSL object
(destructuring-bind (allocator freer &optional setter assign)
(apply (first defas) (rest defas))
;; If there's a setting function, save the form
(when setter (push (funcall setter defsymb) setters))
;; Save the freeing form
(push `(,freer ,defsymb) freers)
;; Save the global assignments
(when assign (push (funcall assign) assigns))
;; Return the allocation form to be used in let
`(,defsymb ,allocator))
;; Not a GSL object, just define it with let
b)))
bindings)))
(if freers
;; There were GSL objects
`(let* (,@assigns ,@bnd)
;; put the body in an unwind-protect
(unwind-protect
(progn
,@setters ; setting the objects
,@body)
,@freers)) ; freeing the objects
;; No GSL objects in the bindings, just make an ordinary let
`(let* (,@bindings) ,@body))))
;;; General definition for object creation
(defmacro defun-letm (symbol arglist &body body)
"Define a GSL object to be bound in a letm.
The body should return a list of two to four values.
The first is the allocation form, the second is
the freeing function name, the third is
form to set or initialize the object,
and the last is a function of no arguments
that gives a form to be bound in a let prior
to binding the object. The symbol will be exported
even though users should not call the function, so that
it will show up in arglist prompters."
`(eval-when (:compile-toplevel :load-toplevel :execute)
(pushnew
(make-gsl-object :name ',name :allocate ',allocate :free ',free
:set ',set :num-alloc-args ,num-alloc-args)
*gsl-objects*
:test #'equalp)))
;; (set-asf poly-complex complex-workspace-alloc complex-workspace-free nil 1)
;; (set-asf mfminimizer allocate-mfminimizer free-mfminimizer set-mfminimizer 2)
(defun gslo-letform (specs specfns)
"Create the let form for GSL objects."
(mapcar
(lambda (s sf)
`(,(second s)
(,(gsl-object-allocate sf)
,@(subseq (cddr s) 0 (gsl-object-num-alloc-args sf)))))
specs specfns))
(defun gslo-setform (specs specfns)
"Create the set forms for GSL objects."
(loop for s in specs for sf in specfns
for addl-set-args
= (subseq (cddr s) (gsl-object-num-alloc-args sf))
when (and (gsl-object-set sf) addl-set-args)
collect
`(,(gsl-object-set sf)
;; presume the thing is the first arg to the set function,
;; then add the other arguments
,@(cons (second s) addl-set-args))))
(export 'with-gsl-objects)
(defmacro with-gsl-objects (specs &body body)
"Allocate, optionally set, and free any foreign object
used in GSL calculations."
(let ((specfns
(mapcar
(lambda (s)
(or (find (first s) *gsl-objects* :key #'gsl-object-name)
(error "Could not find GSL object named ~s" (first s))))
specs)))
`(let (,@(gslo-letform specs specfns))
(unwind-protect
(progn ; call set functions
,@(gslo-setform specs specfns)
,@body)
,@(loop for s in specs for sf in specfns
collect `(,(gsl-object-free sf) ,(second s)))))))
;;; roots-multi needs lambda list
;;; (solver solver-type function initial)
;;; allocate: solver-type (dim0 ,initial)
;;; set: solver function initial
#|
(vector-double vec init)
->
(make-data vector-double nil (length init))
(setf (data vec) init)
;;; Example
(set-asf chebyshev allocate-chebyshev free-chebyshev initialize-chebyshev)
(with-gsl-objects ((chebyshev cheb 40 chebyshev-step 0.0d0 1.0d0))
...)
(LET ((CHEB (ALLOCATE-CHEBYSHEV 40)))
(UNWIND-PROTECT
(PROGN
(INITIALIZE-CHEBYSHEV CHEB CHEBYSHEV-STEP 0.0d0 1.0d0)
...)
(FREE-CHEBYSHEV CHEB)))
|#
(pushnew ',symbol *letm-expanded-object*)
(export ',symbol)
(defun ,symbol ,arglist
(unless *not-for-users*
(error "The form ~a should be placed in the binding of a letm."
',(cons symbol arglist)))
,@body)))
;;; Specific, simple and common types of object creation
(defmacro set-asf (form allocate free &optional set (num-alloc-args 1))
"Make an object usable in letm with the arglist is the allocate
and set arglists appended."
(let ((symb (gensym "SASF")))
`(defun-letm ,(first form)
(,@(subseq (rest form) 0 num-alloc-args)
&optional
,@(when set `((,(nth num-alloc-args (rest form))
nil
settingp)))
,@(when set (subseq (rest form) (1+ num-alloc-args))))
(list
`(,',allocate ,,@(subseq (rest form) 0 num-alloc-args))
',free
,@(when set
`((when settingp
(lambda (,symb)
`(,',set ,,symb ,,@(subseq (rest form) num-alloc-args))))))))))
;; Interpolation allocation, initialization, and freeing.
;; Liam Healy, Sun Nov 4 2007 - 17:24
;; Time-stamp: <2008-01-26 17:40:04EST interpolation.lisp>
;; Time-stamp: <2008-02-02 22:22:59EST interpolation.lisp>
;; $Id: $
(in-package :gsl)
......@@ -8,9 +8,13 @@
;;; A spline is an interpolation that also stores the arrays xa and ya,
;;; so they need not be supplied on each call.
(set-asf
interpolation allocate-interpolation free-interpolation
initialize-interpolation 2)
(defun-letm interpolation (type xa-or-size &optional ya)
(list
`(allocate-interpolation ,type ,(if ya `(dim0 ,ya) xa-or-size))
'free-spline
(when ya
(lambda (symb)
`(initialize-interpolation ,symb ,xa-or-size ,ya (dim0 ,ya))))))
;;; Interpolation
(defun-gsl allocate-interpolation (type size)
......@@ -18,7 +22,7 @@
((type :pointer) (size :size))
:c-return :pointer
:export nil
:index (with-gsl-objects interpolation)
:index (letm interpolation)
:documentation
"Allocate an interpolation object of type for size data-points,
and return the pointer to it.")
......@@ -39,11 +43,17 @@
((interpolation :pointer))
:c-return :void
:export nil
:index (with-gsl-objects interpolation)
:index (letm interpolation)
:documentation
"Frees the interpolation object @var{interp}.")
(set-asf spline allocate-spline free-spline intialize-spline 2)
(defun-letm spline (type xa-or-size &optional ya)
(list
`(allocate-spline ,type ,(if ya `(dim0 ,ya) xa-or-size))
'free-spline
(when ya
(lambda (symb)
`(initialize-spline ,symb ,xa-or-size ,ya (dim0 ,ya))))))
;;; Spline
(defun-gsl allocate-spline (type size)
......
......@@ -9,7 +9,7 @@
(in-package :gsl)
(set-asf acceleration allocate-acceleration free-acceleration nil 0)
(set-asf (acceleration) allocate-acceleration free-acceleration nil 0)
(defun-gsl interpolation-search (x-array x low-index high-index)
"gsl_interp_bsearch"
......@@ -25,7 +25,7 @@
()
:c-return :pointer
:export nil
:index (with-gsl-objects acceleration)
:index (letm acceleration)
:documentation
"Allocate an accelerator object, which is a
kind of iterator for interpolation lookups. It tracks the state of
......@@ -47,7 +47,7 @@
"gsl_interp_accel_free"
((acceleration :pointer))
:export nil
:index (with-gsl-objects acceleration)
:index (letm acceleration)
:c-return :void
:documentation
"Frees the accelerator object.")
;; Linear least squares, or linear regression
;; Liam Healy <2008-01-21 12:41:46EST linear-least-squares.lisp>
;; Time-stamp: <2008-01-28 22:22:22EST linear-least-squares.lisp>
;; Time-stamp: <2008-02-02 21:01:35EST linear-least-squares.lisp>
;; $Id: $
(in-package :gsl)
......@@ -125,12 +125,14 @@
;;;; Multiparameter fitting
;;;;****************************************************************************
(set-asf fit-workspace allocate-fit-workspace free-fit-workspace nil 2)
(set-asf (fit-workspace number-of-observations number-of-parameters)
allocate-fit-workspace free-fit-workspace nil 2)
(defun-gsl allocate-fit-workspace (number-of-observations number-of-parameters)
"gsl_multifit_linear_alloc"
((number-of-observations :size) (number-of-parameters :size))
:c-return :pointer
:index (letm fit-workspace)
:documentation ; FDL
"Allocate a workspace for fitting a linear model.")
......@@ -138,6 +140,7 @@
"gsl_multifit_linear_free"
((pointer :pointer))
:c-return :void
:index (letm fit-workspace)
:documentation ; FDL
"Free the memory associate with the workspace.")
......@@ -310,7 +313,7 @@
(gsl-aref X i 2) (expt (first row) 2)
(gsl-aref y i) (second row)
(gsl-aref w i) (/ (expt (third row) 2))))
(with-gsl-objects ((fit-workspace ws n 3))
(letm ((ws (fit-workspace n 3)))
(setf chisq
(weighted-linear-mfit X w y c cov ws)))
(format t "~&Best fit: Y = ~10,8f + ~10,8f X + ~10,8f X^2"
......
;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28>
;; Time-stamp: <2008-01-28 22:42:05EST minimization-multi.lisp>
;; Time-stamp: <2008-02-02 21:17:03EST minimization-multi.lisp>
;; $Id: $
(in-package :gsl)
......@@ -48,16 +48,18 @@
;;;; Initialization
;;;;****************************************************************************
(set-asf mfminimizer allocate-mfminimizer free-mfminimizer set-mfminimizer 2)
(set-asf
mfdfminimizer allocate-mfdfminimizer free-mfdfminimizer set-mfdfminimizer 2)
;;; Could have one fewer argument: dimension=(dim0 initial)
(set-asf (mfminimizer type dimension function intial step-size)
allocate-mfminimizer free-mfminimizer set-mfminimizer 2)
(set-asf (mfdfminimizer type dimension function-derivative intitial step-size tolerance)
allocate-mfdfminimizer free-mfdfminimizer set-mfdfminimizer 2)
(defun-gsl allocate-mfminimizer (type dimension)
"gsl_multimin_fminimizer_alloc"
((type :pointer) (dimension :size))
:c-return :pointer
:export nil
:index (with-gsl-objects mfminimizer)
:index (letm mfminimizer)
:documentation ; FDL
"Allocate an instance of a minimizer of the given for an
function of the given dimensions.")
......@@ -67,7 +69,7 @@
((type :pointer) (dimension :size))
:c-return :pointer
:export nil
:index (with-gsl-objects mfdfminimizer)
:index (letm mfdfminimizer)
:documentation ; FDL
"Allocate an instance of a derivative-based minimizer of the given for an
function of the given dimensions.")
......@@ -77,7 +79,7 @@
((minimizer :pointer) (function :pointer)
((pointer initial) :pointer) ((pointer step-size) :pointer))
:export nil
:index (with-gsl-objects mfminimizer)
:index (letm mfminimizer)
:documentation ; FDL
"Initialize the minimizer to minimize the function
starting from the initial point.
......@@ -92,7 +94,7 @@
((pointer initial) :pointer) (step-size :double)
(tolerance :double))
:export nil
:index (with-gsl-objects mfdfminimizer)
:index (letm mfdfminimizer)
:documentation ; FDL
"Initialize the minimizer to minimize the function
starting from the initial point. The size of the
......@@ -108,7 +110,7 @@
((minimizer :pointer))
:c-return :void
:export nil
:index (with-gsl-objects mfminimizer)
:index (letm mfminimizer)
:documentation ; FDL
"Free all the memory associated with the minimizer.")
......@@ -117,7 +119,7 @@
((minimizer :pointer))
:c-return :void
:export nil
:index (with-gsl-objects mfdfminimizer)
:index (letm mfdfminimizer)
:documentation ; FDL
"Free all the memory associated with the minimizer.")
......@@ -345,9 +347,9 @@
(defun multimin-example-fletcher-reeves ()
(with-data (initial vector-double 2)
(setf (data initial) #(5.0d0 7.0d0))
(with-gsl-objects
((mfdfminimizer minimizer *conjugate-fletcher-reeves* 2 parabaloid
initial 0.01d0 1.0d-4))
(letm ((minimizer
(mfdfminimizer *conjugate-fletcher-reeves* 2 parabaloid
initial 0.01d0 1.0d-4)))
(loop with status = T
for iter from 0 below 100
while status
......@@ -378,9 +380,8 @@
(with-data (step-size vector-double 2)
(setf (data initial) #(5.0d0 7.0d0))
(set-all step-size 1.0d0)
(with-gsl-objects
((mfminimizer
minimizer *simplex-nelder-mead* 2 parabaloid-f initial step-size))
(letm ((minimizer
(mfminimizer *simplex-nelder-mead* 2 parabaloid-f initial step-size)))
(loop with status = T and size
for iter from 0 below 100
while status
......
;; Univariate minimization
;; Liam Healy Tue Jan 8 2008 - 21:02
;; Time-stamp: <2008-01-26 19:33:45EST minimization-one.lisp>
;; Time-stamp: <2008-02-02 21:12:20EST minimization-one.lisp>
;; $Id: $
(in-package :gsl)
......@@ -9,14 +9,15 @@
;;;; Initialization
;;;;****************************************************************************
(set-asf fminimizer allocate-fminimizer free-fminimizer set-fminimizer)
(set-asf (fminimizer type function minimum lower upper)
allocate-fminimizer free-fminimizer set-fminimizer)
(defun-gsl allocate-fminimizer (type)
"gsl_min_fminimizer_alloc"
((type :pointer))
:c-return :pointer
:export nil
:index (with-gsl-objects fminimizer)
:index (letm fminimizer)
:documentation
"Allocate an instance of a minimizer of the given type.")
......@@ -25,13 +26,13 @@
((minimizer :pointer) (function :pointer)