Commit 42e2d608 authored by Liam Healy's avatar Liam Healy

Pure defmfun callbacks dynamically specified fully functional

Redefine the form of :callback-dynamic to be
(dimensions (function scalarsp) ...)
and usage in numerical-differentiation, numerical-integration, and
monte-carlo.  Parse this variable in callbacks.lisp with #'cbd-dimensions
and #'cbd-functions.  Fix error in wfo-declare which had gsl-function
hardwired.  If manually defined (defconstant +success+ 0),
all tests that pass in master also pass here:
SBCL
TOTAL: 1451 assertions passed, 5 failed, 0 execution errors.
CCL
TOTAL: 1454 assertions passed, 2 failed, 0 execution errors.
parent 74c8475e
;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42
;; Time-stamp: <2009-03-30 22:29:48EDT monte-carlo.lisp>
;; Time-stamp: <2009-03-31 22:07:09EDT monte-carlo.lisp>
;; $Id$
(in-package :gsl)
......@@ -49,8 +49,8 @@
:inputs (lower-limits upper-limits)
:callbacks
(callback monte-function (dimensions)
(function :double (:double :cvector dim0) :slug))
:callback-dynamic ((function scalars (dim0 lower-limits)))
(function :double (:input :double :cvector dim0) :slug))
:callback-dynamic (((dim0 lower-limits)) (function scalars))
:documentation ; FDL
"Uses the plain Monte Carlo algorithm to integrate the
function f over the hypercubic region defined by the
......@@ -128,8 +128,9 @@
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks
(callback monte-function (dimensions) (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
(callback monte-function (dimensions)
(function :double (:input :double :cvector dim0) :slug))
:callback-dynamic (((dim0 lower-limits)) (function scalars))
:documentation ; FDL
"Uses the miser Monte Carlo algorithm to integrate the
function f over the hypercubic region defined by the
......@@ -217,8 +218,9 @@
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks
(callback monte-function (dimensions) (function :double (:double :cvector dim0)))
:callback-dynamic ((function scalars (dim0 lower-limits)))
(callback monte-function (dimensions)
(function :double (:input :double :cvector dim0) :slug))
:callback-dynamic (((dim0 lower-limits)) (function scalars))
:documentation ; FDL
"Uses the vegas Monte Carlo algorithm to integrate the
function f over the dim-dimensional hypercubic region
......
;; Numerical differentiation.
;; Liam Healy Mon Nov 12 2007 - 22:07
;; Time-stamp: <2009-03-30 22:26:38EDT numerical-differentiation.lisp>
;; Time-stamp: <2009-03-31 22:08:34EDT numerical-differentiation.lisp>
;; $Id$
(in-package :gsl)
......@@ -16,7 +16,7 @@
(result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Compute the numerical derivative of the function
at the point x using an adaptive central difference algorithm with
......@@ -39,7 +39,7 @@
(result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Compute the numerical derivative of the function
at the point x using an adaptive forward difference algorithm with
......@@ -64,7 +64,7 @@
(result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Compute the numerical derivative of the function at the point x
using an adaptive backward difference algorithm with a step-size of
......
;; Numerical integration
;; Liam Healy, Wed Jul 5 2006 - 23:14
;; Time-stamp: <2009-03-30 22:25:31EDT numerical-integration.lisp>
;; Time-stamp: <2009-03-31 22:09:43EDT numerical-integration.lisp>
;; $Id$
;;; To do: QAWS, QAWO, QAWF, more tests
......@@ -25,7 +25,7 @@
(result :double) (abserr :double) (neval sizet))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Apply the Gauss-Kronrod 10-point, 21-point, 43-point and
87-point integration rules in succession until an estimate of the
......@@ -67,7 +67,7 @@
(result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Apply an integration rule adaptively until an estimate
of the integral of f over (a,b) is achieved within the
......@@ -102,7 +102,7 @@
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Apply the Gauss-Kronrod 21-point integration rule
adaptively until an estimate of the integral of f over
......@@ -133,7 +133,7 @@
:inputs (points)
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Apply the adaptive integration algorithm QAGS taking
account of the user-supplied locations of singular points. The array
......@@ -160,7 +160,7 @@
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Compute the integral of the function f over the
infinite interval (-\infty,+\infty). The integral is mapped onto the
......@@ -182,7 +182,7 @@
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Compute the integral of the function f over the
semi-infinite interval (a,+\infty). The integral is mapped onto the
......@@ -200,7 +200,7 @@
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Compute the integral of the function f over the
semi-infinite interval (-\infty,b). The integral is mapped onto the
......@@ -223,7 +223,7 @@
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:callback-dynamic (nil (function))
:documentation ; FDL
"Compute the Cauchy principal value of the integral of
f over (a,b), with a singularity at c,
......
......@@ -312,22 +312,11 @@ area of memory.</p>
<h3>Passing functions</h3>
<p>
Functions that are passed to GSL functions (known as <i>callbacks</i>
in C) are defined by writing an ordinary CL function or functions and
then calling <code>make-callbacks</code> with arguments that
depend on the application. Functions or objects that require a
callback will accept the symbol representing the first or only function
defined in the <code>make-callbacks</code>. For example, after
defining an ordinary CL function <code>mcrw</code>,
<pre>
(make-callbacks monte-carlo mcrw 3)
(monte-carlo-integrate-plain 'mcrw lower upper nsamples rng ws)
</pre>
<p>
In some cases, the CL function can be written to accept and return
either scalars or arrays. See examples for numerical
integration, numerical differentiation, Chebyshev, root solvers,
minimizers, Monte Carlo, nonlinear least squares, and ordinary
differential equation solvers.
in C) are specified with function designator for the CL function.
There is usually an option <code>scalarsp</code> for functions
that take or return arrays that, if true, will
send the user function the argument element by element, and expect
the return values to be the individual elements.
</p>
<h3>GSL objects</h3>
......@@ -396,7 +385,7 @@ and arrays used internally or for function return.
<!-- Created: Feb 25 2005 -->
<!-- hhmts start -->
<small>
Time-stamp: <2009-03-20 11:54:53EDT index.html>
Time-stamp: <2009-03-31 22:27:06EDT index.html>
</small>
<!-- hhmts end -->
</div>
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-03-30 22:27:41EDT gsll.asd>
;; Time-stamp: <2009-03-31 22:11:14EDT gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -176,7 +176,7 @@
:depends-on (init data random)
:components
((:file "numerical-integration")
;;(:file "monte-carlo")
(:file "monte-carlo")
(:file "numerical-differentiation")))
(:module ordinary-differential-equations
:depends-on (init)
......
;; The mobject that defines callbacks
;; Liam Healy 2009-03-14 11:20:03EDT callback-included.lisp
;; Time-stamp: <2009-03-29 16:12:31EDT callback-included.lisp>
;; Time-stamp: <2009-03-31 22:10:34EDT callback-included.lisp>
;; $Id: $
(in-package :gsl)
......@@ -71,4 +71,4 @@
class
(number-of-callbacks (get-callbacks-for-class class))))
for n from 0
append `(,symb (nth ,n (funcallables ,callback-object))))))))
append `(,symb (nth ,n (funcallables ,callback-object)))))))
;; Foreign callback functions.
;; Liam Healy
;; Time-stamp: <2009-03-30 22:14:14EDT callback.lisp>
;; Time-stamp: <2009-03-31 22:15:12EDT callback.lisp>
;; $Id$
(in-package :gsl)
......@@ -135,13 +135,6 @@
;;; &optional (return-spec 'double-float) (argument-spec 'double-float)
;;; set1-spec set2-spec)
;;; and each of the *-spec are (type array-type &rest dimensions).
;;; The :callback-dynamic is a list of functions corresponding in
;;; order to the cddr of the :callbacks argument (function... ) in which
;;; each element is a list of (function scalarsp &rest dimensions)
;;; where
;;; function = function designator,
;;; scalarsp = flag determining whether to pass/accept scalars or arrays
;;; dimensions = dimension of the problem
(defun parse-callback-static (callbacks component)
"Get the information component from the callbacks list."
......@@ -194,14 +187,29 @@
;;;; Form generation
;;;;****************************************************************************
(defun callback-symbol-set (functions callbacks symbols)
;;; The :callback-dynamic is a list of the form
;;; (dimensions (function scalarsp) ...)
;;; This is used in defmfuns that send callbacks directly, with no mobject.
;;; With functions given in the same order as
;;; the in the :callbacks argument
;;; function = function designator,
;;; scalarsp = flag determining whether to pass/accept scalars or arrays
;;; dimensions = source dimensions, a list
(defun cbd-dimensions (callback-dynamic)
(first callback-dynamic))
(defun cbd-functions (callback-dynamic)
(rest callback-dynamic))
(defun callback-symbol-set (callback-dynamic callbacks symbols)
"Generate the form to set each of the dynamic (special) variables
to (function scalarsp dimensions...) in the body of the demfun for
each of the callback functions."
(when callbacks
`((setf
,@(loop for symb in symbols
for function in functions
for function in (cbd-functions callback-dynamic)
for fnspec in (parse-callback-static callbacks 'functions)
append
`(,symb
......@@ -209,17 +217,20 @@
,(first function)
',fnspec
,(second function)
,(cddr function))))))))
,(cons 'list (cbd-dimensions callback-dynamic)))))))))
(defun callback-set-slots (callbacks dynamic-variables)
(defun callback-set-slots (callbacks dynamic-variables callback-dynamic)
"Set the slots in the foreign callback struct."
(when callbacks
`((set-cbstruct
,(parse-callback-static callbacks 'foreign-argument)
',(parse-callback-static callbacks 'callback-structure-type)
,(when (parse-callback-static callbacks 'dimension-names)
`(mapcan 'list
',(parse-callback-static callbacks 'dimension-names)
(cddr ,(caar dynamic-variables))))
(cons 'list
(loop
for dim-name in (parse-callback-static callbacks 'dimension-names)
for dim in (cbd-dimensions callback-dynamic)
append (list `',dim-name dim))))
,(cons
'list
(loop for symb in (second dynamic-variables)
......
;; Helpers that define a single GSL function interface
;; Liam Healy 2009-01-07 22:02:20EST defmfun-single.lisp
;; Time-stamp: <2009-03-30 21:50:25EDT defmfun-single.lisp>
;; Time-stamp: <2009-03-31 21:37:38EDT defmfun-single.lisp>
;; $Id: $
(in-package :gsl)
......@@ -189,7 +189,8 @@
callback-dynamic callbacks (first callback-dynamic-variables))
before
(when callback-object (callback-set-dynamic callback-object arglist)))
,@(callback-set-slots callbacks callback-dynamic-variables)
,@(callback-set-slots
callbacks callback-dynamic-variables callback-dynamic)
(let ((,cret-name
(cffi:foreign-funcall
,gsl-name
......
;; Generate a lambda that calls the user function; will be called by callback.
;; Liam Healy
;; Time-stamp: <2009-03-30 21:08:16EDT funcallable.lisp>
;; Time-stamp: <2009-03-31 22:22:50EDT funcallable.lisp>
;; $Id$
(in-package :gsl)
......@@ -112,9 +112,7 @@
form
`(multiple-value-bind ,mvbvbls
,form
(setf ,@(loop for arg in setargs
for mvbvbl in mvbvbls
for count in counts
(setf ,@(loop for count in counts
with svs = (copy-list setvbls)
and mvv = (copy-list mvbvbls)
append
......
;; Macros to interface GSL functions, including definitions necessary for defmfun.
;; Liam Healy
;; Time-stamp: <2009-03-21 16:43:54EDT interface.lisp>
;; Time-stamp: <2009-03-31 21:52:25EDT interface.lisp>
;; $Id$
(in-package :gsl)
......@@ -65,7 +65,7 @@
`(',(st-eltype d) ,(st-dim d))
(if (eq (st-symbol d)
(parse-callback-static callbacks 'foreign-argument))
'('gsl-function)
`(',(parse-callback-static callbacks 'callback-structure-type))
`(',(st-type d))))))
;;;;****************************************************************************
......
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