Commit cd435bbf authored by Liam Healy's avatar Liam Healy

Third element of :callbacks is list of dimension names

Previously, the dimension-names always defaulted.  Changed all
relevant definitions so that third element of :callbacks is a list of
the dimension names, which must be explicitly specified.  All the
expected tests pass on recompilation.
parent ffdf633a
;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42
;; Time-stamp: <2009-03-07 16:39:34EST monte-carlo.lisp>
;; Time-stamp: <2009-03-21 23:48:35EDT monte-carlo.lisp>
;; $Id$
(in-package :gsl)
......@@ -10,6 +10,15 @@
;;; /usr/include/gsl/gsl_monte_miser.h
;;; /usr/include/gsl/gsl_monte_vegas.h
;;;;****************************************************************************
;;;; Callback definition
;;;;****************************************************************************
(cffi:defcstruct monte-function
(function :pointer)
(dimensions sizet)
(parameters :pointer))
;;;;****************************************************************************
;;;; PLAIN Monte Carlo
;;;;****************************************************************************
......@@ -38,7 +47,8 @@
((mpointer state) :pointer)
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks (callback monte-function (function :double (:double :cvector dim0)))
:callbacks
(callback monte-function dimensions (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
:documentation ; FDL
"Uses the plain Monte Carlo algorithm to integrate the
......@@ -116,7 +126,8 @@
((mpointer state) :pointer)
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks (callback monte-function (function :double (:double :cvector dim0)))
:callbacks
(callback monte-function dimensions (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
:documentation ; FDL
"Uses the miser Monte Carlo algorithm to integrate the
......@@ -204,7 +215,8 @@
((mpointer state) :pointer)
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks (callback monte-function (function :double (:double :cvector dim0)))
:callbacks
(callback monte-function dimensions (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
:documentation ; FDL
"Uses the vegas Monte Carlo algorithm to integrate the
......@@ -220,22 +232,6 @@
is returned via the state struct component, s->chisq, and must be
consistent with 1 for the weighted average to be reliable.")
;;;;****************************************************************************
;;;; Callback definition
;;;;****************************************************************************
(cffi:defcstruct monte-function
(function :pointer)
(dimensions sizet)
(parameters :pointer))
(def-make-callbacks monte-carlo (function dimension)
`(defmcallback ,function
:double ((:double ,dimension))
nil
nil
,function))
;;;;****************************************************************************
;;;; Examples and unit test
;;;;****************************************************************************
......@@ -247,8 +243,6 @@
(* (/ (expt pi 3))
(/ (- 1 (* (cos x) (cos y) (cos z))))))
;;(make-callbacks monte-carlo mcrw 3)
(defun random-walk-plain-example (&optional (nsamples 500000))
(let ((ws (make-monte-carlo-plain 3))
(lower #m(0.0d0 0.0d0 0.0d0))
......
;; Numerical differentiation.
;; Liam Healy Mon Nov 12 2007 - 22:07
;; Time-stamp: <2009-03-02 09:25:00EST numerical-differentiation.lisp>
;; Time-stamp: <2009-03-21 23:46:52EDT numerical-differentiation.lisp>
;; $Id$
(in-package :gsl)
......@@ -14,7 +14,7 @@
"gsl_deriv_central"
((callback :pointer) (x :double) (step :double)
(result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the numerical derivative of the function
......@@ -36,7 +36,7 @@
"gsl_deriv_forward"
((callback :pointer) (x :double) (step :double)
(result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the numerical derivative of the function
......@@ -60,7 +60,7 @@
"gsl_deriv_backward"
((callback :pointer) (x :double) (step :double)
(result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the numerical derivative of the function at the point x
......
;; Numerical integration
;; Liam Healy, Wed Jul 5 2006 - 23:14
;; Time-stamp: <2009-03-02 09:24:15EST numerical-integration.lisp>
;; Time-stamp: <2009-03-21 23:47:23EDT numerical-integration.lisp>
;; $Id$
;;; To do: QAWS, QAWO, QAWF, more tests
......@@ -23,7 +23,7 @@
(a :double) (b :double)
(absolute-error :double) (relative-error :double)
(result :double) (abserr :double) (neval sizet))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Apply the Gauss-Kronrod 10-point, 21-point, 43-point and
......@@ -64,7 +64,7 @@
(absolute-error :double) (relative-error :double)
(limit sizet) (method integrate-method) ((mpointer workspace) :pointer)
(result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Apply an integration rule adaptively until an estimate
......@@ -98,7 +98,7 @@
(a :double) (b :double)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Apply the Gauss-Kronrod 21-point integration rule
......@@ -128,7 +128,7 @@
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:inputs (points)
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Apply the adaptive integration algorithm QAGS taking
......@@ -154,7 +154,7 @@
((callback :pointer)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the integral of the function f over the
......@@ -175,7 +175,7 @@
((callback :pointer) (a :double)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the integral of the function f over the
......@@ -192,7 +192,7 @@
((callback :pointer) (b :double)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the integral of the function f over the
......@@ -214,7 +214,7 @@
(a :double) (b :double) (c :double)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the Cauchy principal value of the integral of
......
;; Chebyshev Approximations
;; Liam Healy Sat Nov 17 2007 - 20:36
;; Time-stamp: <2009-03-18 20:54:02EDT chebyshev.lisp>
;; Time-stamp: <2009-03-21 23:49:02EDT chebyshev.lisp>
;; $Id$
(in-package :gsl)
......@@ -16,7 +16,7 @@
"Chebyshev series"
:documentation ; FDL
"Make a Chebyshev series of specified order."
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:initialize-suffix "init"
:initialize-args
((callback :pointer) (lower-limit :double) (upper-limit :double))
......
;; The mobject that defines callbacks
;; Liam Healy 2009-03-14 11:20:03EDT callback-included.lisp
;; Time-stamp: <2009-03-19 21:06:00EDT callback-included.lisp>
;; Time-stamp: <2009-03-22 00:02:37EDT callback-included.lisp>
;; $Id: $
(in-package :gsl)
......@@ -36,14 +36,14 @@
slot."))
(defmacro def-ci-subclass
(class-name superclasses documentation
&optional (dimension-names '(dimensions)))
(class-name superclasses documentation dimension-names)
`(defclass ,class-name ,superclasses
((dimension-names :initform ',dimension-names :allocation :class))
(:documentation ,documentation)))
(defmacro def-ci-subclass-1d
(class-name superclasses documentation)
(class-name superclasses documentation ignore)
(declare (ignore ignore))
`(defclass ,class-name ,superclasses
((dimension-names :initform nil :allocation :class)
(dimensions :initform '(1) :allocation :class)
......
;; Foreign callback functions.
;; Liam Healy
;; Time-stamp: <2009-03-21 16:25:25EDT callback.lisp>
;; Time-stamp: <2009-03-21 23:43:36EDT callback.lisp>
;; $Id$
(in-package :gsl)
......@@ -125,7 +125,7 @@
;;;;****************************************************************************
;;; The :callbacks argument is a list of the form:
;;; (foreign-argument callback-structure-type function ...)
;;; (foreign-argument callback-structure-type dimension-names function ...)
;;; where each function is of the form
;;; (structure-slot-name
;;; &optional (return-spec 'double-float) (argument-spec 'double-float)
......@@ -139,30 +139,13 @@
;;; scalarsp = flag determining whether to pass/accept scalars or arrays
;;; dimensions = dimension of the problem
(defun parse-callback-static (callbacks component &optional fn-num arg-component)
"Get the information component from the callbacks list. Where
specific to a particular function, get the information for function
n (0, 1, 2)."
(defun parse-callback-static (callbacks component)
"Get the information component from the callbacks list."
(case component
(foreign-argument (first callbacks))
(callback-structure-type (second callbacks))
(functions (cddr callbacks))
;; The parts below are obsolete?
(t
(let* ((fn (nth fn-num (cddr callbacks)))
(comp
(case component
(function fn)
(structure-slot-name (first fn))
(return-spec (or (second fn) :double))
(argument-spec (or (third fn) :double))
(set1-spec (fourth fn))
(set2-spec (fifth fn)))))
(case arg-component
(element-type (first comp)) ; but it's always :double when this is a list
(array-type (second comp))
(dimensions (cddr comp))
(t comp)))))) ; just the element-type as a symbol
(dimension-names (third callbacks))
(functions (nthcdr 3 callbacks))))
(defun number-of-callbacks (callbacks)
(length (parse-callback-static callbacks 'functions)))
......@@ -185,25 +168,6 @@
(array-type (when (listp argspec) (second argspec)))
(dimensions (when (listp argspec) (cddr argspec)))))
#|
(defparameter *cblist*
'(callback monte-function (function :double (:double :cvector dim0))))
(parse-callback-static *cblist* 'foreign-argument)
CALLBACK
(parse-callback-static *cblist* 'callback-structure-type)
MONTE-FUNCTION
(parse-callback-static *cblist* 'structure-slot-name 0)
FUNCTION
(parse-callback-static *cblist* 'return-spec 0)
:DOUBLE
(parse-callback-static *cblist* 'argument-spec 0)
(:DOUBLE :CVECTOR DIM0)
(parse-callback-static *cblist* 'argument-spec 0 'array-type)
:CVECTOR
(parse-callback-static *cblist* 'argument-spec 0 'dimensions)
(DIM0)
|#
;;;;****************************************************************************
;;;; Using callback specification in function arugments
;;;;****************************************************************************
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2009-03-21 21:34:28EDT mobject.lisp>
;; Time-stamp: <2009-03-22 00:02:39EDT mobject.lisp>
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
;;; The macro demobject takes care of defining the appropriate
......@@ -85,8 +85,7 @@
,class
,superclasses
,(format nil "The GSL representation of the ~a." description)
;; Class slots go here
)
,(parse-callback-static callbacks 'dimension-names))
`(defclass ,class ,superclasses
nil
(:documentation
......@@ -203,8 +202,7 @@
(let ((object
(make-instance
',class
,@(when
callbacks `(:callbacks ',callbacks))
,@(when callbacks `(:callbacks ',callbacks))
,@(symbol-keyword-symbol
(callback-remove-arg class-slots-instance callbacks))
,@(when (callback-arg-p class-slots-instance callbacks)
......
;; Generic functions for optimization
;; Liam Healy 2009-01-03 12:59:07EST generic.lisp
;; Time-stamp: <2009-02-21 16:47:51EST generic.lisp>
;; Time-stamp: <2009-03-21 23:52:17EDT generic.lisp>
;; $Id: $
(in-package :gsl)
......@@ -34,7 +34,7 @@
;; See /usr/include/gsl/gsl_multiroots.h
"The definition of a function for multiroot finding in GSL."
(function :pointer)
(dimensions sizet)
(dimension sizet)
(parameters :pointer))
(cffi:defcstruct gsl-mfunction-fdf
......@@ -44,7 +44,7 @@
(function :pointer)
(df :pointer)
(fdf :pointer)
(dimensions sizet)
(dimension sizet)
(parameters :pointer))
;;;;****************************************************************************
......
;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28>
;; Time-stamp: <2009-03-21 18:15:41EDT minimization-multi.lisp>
;; Time-stamp: <2009-03-22 00:03:34EDT minimization-multi.lisp>
;; $Id$
(in-package :gsl)
......@@ -38,7 +38,7 @@
initial trial steps is given in vector step-size. The precise
meaning of this parameter depends on the method used."
:callbacks
(callback gsl-mfunction
(callback gsl-mfunction (dimension)
(function :double (:double :marray dim0)))
:initialize-suffix "set"
:initialize-args ;; Could have one fewer argument: dimension=(dim0 initial)
......@@ -62,7 +62,7 @@
direction p to a relative accuracy of tolerance, where dot(p,g) <
tol |p| |g|."
:callbacks
(callback gsl-mfunction-fdf
(callback gsl-mfunction-fdf (dimension)
(function :double (:double :marray dim0))
(df :void
(:double :marray dim0)
......
;; Univariate minimization
;; Liam Healy Tue Jan 8 2008 - 21:02
;; Time-stamp: <2009-03-18 20:47:02EDT minimization-one.lisp>
;; Time-stamp: <2009-03-21 23:56:38EDT minimization-one.lisp>
;; $Id$
(in-package :gsl)
......@@ -17,10 +17,10 @@
((type :pointer))
"one-dimensional minimizer"
:documentation ; FDL
"Make an instance of a minimizer of the given type. Optionally
"Make an instance of a minimizer of tphe given type. Optionally
set to use the function and the initial search interval [lower,
upper], with a guess for the location of the minimum."
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:initialize-suffix "set" ; should use set_with_values?
:initialize-args
((callback :pointer) (minimum :double) (lower :double) (upper :double))
......
;; Nonlinear least squares fitting.
;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp
;; Time-stamp: <2009-03-19 11:13:41EDT nonlinear-least-squares.lisp>
;; Time-stamp: <2009-03-21 23:56:35EDT nonlinear-least-squares.lisp>
;; $Id$
(in-package :gsl)
......@@ -21,9 +21,11 @@
"nonlinear least squares fit with function only"
:documentation ; FDL
"The number of observations must be greater than or equal to parameters."
:superclasses (callback-included)
:ci-class-slots
(gsl-ffit-function nil (function) (number-of-observations number-of-parameters))
:callbacks
(callback gsl-ffit-function
(number-of-observations number-of-parameters)
(function :success-failure
(:double :marray dim1) (:double :marray dim0)))
:initialize-suffix "set"
:initialize-args ((callback :pointer) ((mpointer initial-guess) :pointer))
:singular (function))
......@@ -67,10 +69,13 @@
:documentation ; FDL
"The number of observations must be greater than or
equal to parameters."
:superclasses (callback-included)
:ci-class-slots
(gsl-fdffit-function marray (function df fdf)
(number-of-observations number-of-parameters))
:callbacks
(callback gsl-fdffit-function
(number-of-observations number-of-parameters)
(function :success-failure
(:double :marray dim1) (:double :marray dim0))
(df ???????????)
(fdf ????????????))
:initialize-suffix "set"
:initialize-args ((callback :pointer) ((mpointer initial-guess) :pointer)))
......
;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08
;;; Time-stamp: <2009-03-21 17:42:43EDT roots-multi.lisp>
;;; Time-stamp: <2009-03-22 00:03:35EDT roots-multi.lisp>
;;; $Id$
(in-package :gsl)
......@@ -29,7 +29,7 @@
:initialize-suffix "set"
:initialize-args ((callback :pointer) ((mpointer initial) :pointer))
:callbacks
(callback gsl-mfunction
(callback gsl-mfunction (dimension)
(function :success-failure
(:double :marray dim0) (:double :marray dim0)))
:arglists-function
......@@ -54,7 +54,7 @@
:initialize-suffix "set"
:initialize-args ((callback :pointer) ((mpointer initial) :pointer))
:callbacks
(callback gsl-mfunction-fdf
(callback gsl-mfunction-fdf (dimension)
(function :success-failure
(:double :marray dim0)
(:double :marray dim0))
......
;; One-dimensional root solver.
;; Liam Healy
;; Time-stamp: <2009-03-18 20:20:03EDT roots-one.lisp>
;; Time-stamp: <2009-03-21 23:53:41EDT roots-one.lisp>
;; $Id$
(in-package :gsl)
......@@ -16,7 +16,7 @@
"one-dimensional root solver with function only"
:initialize-suffix "set"
:initialize-args ((callback :pointer) (lower :double) (upper :double))
:callbacks (callback gsl-function (function))
:callbacks (callback gsl-function nil (function))
:singular (function))
(defmobject one-dimensional-root-solver-fdf "gsl_root_fdfsolver"
......@@ -25,7 +25,7 @@
:initialize-suffix "set"
:initialize-args ((callback :pointer) (root-guess :double))
:callbacks
(callback gsl-function-fdf
(callback gsl-function-fdf nil
(function)
(df)
(fdf :void :double (:double :cvector 1) (:double :cvector 1)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment