Commit 74c8475e authored by Liam Healy's avatar Liam Healy
Browse files

Pure-defmfun callbacks with funcallables

Both numerical-differentiation and numerical-integration have new
:callbacks and the expansion calls new function
#'make-compiled-funcallable which makes the funcallable at
function-call time.  Spot tests of both work.  If a function passed to
set-slot-function is nil, it will set the slot to null-pointer.
parent 741fd237
;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42
;; Time-stamp: <2009-03-22 00:18:55EDT monte-carlo.lisp>
;; Time-stamp: <2009-03-30 22:29:48EDT monte-carlo.lisp>
;; $Id$
(in-package :gsl)
......@@ -48,7 +48,8 @@
(result :double) (abserr :double))
:inputs (lower-limits upper-limits)
:callbacks
(callback monte-function (dimensions) (function :double (:double :cvector dim0)))
(callback monte-function (dimensions)
(function :double (:double :cvector dim0) :slug))
:callback-dynamic ((function scalars (dim0 lower-limits)))
:documentation ; FDL
"Uses the plain Monte Carlo algorithm to integrate the
......
;; Numerical differentiation.
;; Liam Healy Mon Nov 12 2007 - 22:07
;; Time-stamp: <2009-03-21 23:46:52EDT numerical-differentiation.lisp>
;; Time-stamp: <2009-03-30 22:26:38EDT numerical-differentiation.lisp>
;; $Id$
(in-package :gsl)
......@@ -14,7 +14,8 @@
"gsl_deriv_central"
((callback :pointer) (x :double) (step :double)
(result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the numerical derivative of the function
......@@ -36,7 +37,8 @@
"gsl_deriv_forward"
((callback :pointer) (x :double) (step :double)
(result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the numerical derivative of the function
......@@ -60,7 +62,8 @@
"gsl_deriv_backward"
((callback :pointer) (x :double) (step :double)
(result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
: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-21 23:47:23EDT numerical-integration.lisp>
;; Time-stamp: <2009-03-30 22:25:31EDT numerical-integration.lisp>
;; $Id$
;;; To do: QAWS, QAWO, QAWF, more tests
......@@ -23,7 +23,8 @@
(a :double) (b :double)
(absolute-error :double) (relative-error :double)
(result :double) (abserr :double) (neval sizet))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Apply the Gauss-Kronrod 10-point, 21-point, 43-point and
......@@ -64,7 +65,8 @@
(absolute-error :double) (relative-error :double)
(limit sizet) (method integrate-method) ((mpointer workspace) :pointer)
(result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Apply an integration rule adaptively until an estimate
......@@ -98,7 +100,8 @@
(a :double) (b :double)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Apply the Gauss-Kronrod 21-point integration rule
......@@ -128,7 +131,8 @@
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:inputs (points)
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Apply the adaptive integration algorithm QAGS taking
......@@ -154,7 +158,8 @@
((callback :pointer)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the integral of the function f over the
......@@ -175,7 +180,8 @@
((callback :pointer) (a :double)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the integral of the function f over the
......@@ -192,7 +198,8 @@
((callback :pointer) (b :double)
(absolute-error :double) (relative-error :double) (limit sizet)
((mpointer workspace) :pointer) (result :double) (abserr :double))
:callbacks (callback gsl-function nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the integral of the function f over the
......@@ -214,7 +221,8 @@
(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 nil (function))
:callbacks
(callback gsl-function nil (function :double (:input :double) :slug))
:callback-dynamic ((function))
:documentation ; FDL
"Compute the Cauchy principal value of the integral of
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-03-29 12:54:31EDT gsll.asd>
;; Time-stamp: <2009-03-30 22:27:41EDT gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
:name "gsll"
:description "GNU Scientific Library for Lisp."
:version "0"
:author "Liam M. Healy"
:licence "LLGPL v3, FDL"
:depends-on (cffi trivial-garbage cl-utilities)
:components
((:module init
:components
((:file "init")
(:file "forms")
(:file "conditions" :depends-on (init))
(:file "number-conversion" :depends-on (init))
(:file "callback-compile-defs" :depends-on (init))
(:file "mobject" :depends-on (init callback-compile-defs))
(:file "callback-included" :depends-on (mobject))
(:file "callback" :depends-on (init forms number-conversion callback-included))
(:file "funcallable")
(:file "types" :depends-on (init))
(:file "complex-types" :depends-on (types))
(:file "element-types" :depends-on (init complex-types))
(:file "interface"
:depends-on (init conditions element-types number-conversion))
(:file "defmfun" :depends-on (init forms element-types interface))
(:file "defmfun-array" :depends-on (defmfun callback-included))
(:file "defmfun-single" :depends-on (defmfun mobject callback))
(:file "generate-examples" :depends-on (init))))
(:module floating-point
:depends-on (init)
:components
((:file "ieee-modes")
(:file "floating-point")))
(:module mathematical
:depends-on (init)
:components
((:file "mathematical")
(:file "complex")))
(:module data
:depends-on (init)
:components
((:file "foreign-friendly")
(:file "foreign-array" :depends-on (foreign-friendly))
(:file "marray" :depends-on (foreign-array))
(:file "vector" :depends-on (marray))
(:file "matrix" :depends-on (marray vector))
(:file "maref" :depends-on (marray vector matrix))
(:file "both" :depends-on (marray vector matrix))
(:file "copy-cl")
(:file "array-tests" :depends-on (both))
(:file "permutation" :depends-on (marray))
(:file "combination" :depends-on (marray))))
(:file "polynomial" :depends-on (init data))
(:module special-functions
:depends-on (init)
:components
((:file "return-structures")
(:file "airy" :depends-on (return-structures))
(:file "bessel" :depends-on (return-structures))
(:file "clausen" :depends-on (return-structures))
(:file "coulomb" :depends-on (return-structures))
(:file "coupling" :depends-on (return-structures))
(:file "dawson" :depends-on (return-structures))
(:file "debye" :depends-on (return-structures))
(:file "dilogarithm" :depends-on (return-structures))
(:file "elementary" :depends-on (return-structures))
(:file "elliptic-integrals" :depends-on (return-structures))
(:file "elliptic-functions" :depends-on (return-structures))
(:file "error-functions" :depends-on (return-structures))
(:file "exponential-functions" :depends-on (return-structures))
(:file "exponential-integrals" :depends-on (return-structures))
(:file "fermi-dirac" :depends-on (return-structures))
(:file "gamma" :depends-on (return-structures))
(:file "gegenbauer" :depends-on (return-structures))
(:file "hypergeometric" :depends-on (return-structures))
(:file "laguerre" :depends-on (return-structures))
(:file "lambert" :depends-on (return-structures))
(:file "legendre" :depends-on (return-structures))
(:file "logarithm" :depends-on (return-structures))
(:file "mathieu" :depends-on (return-structures))
(:file "power" :depends-on (return-structures))
(:file "psi" :depends-on (return-structures))
(:file "synchrotron" :depends-on (return-structures))
(:file "transport" :depends-on (return-structures))
(:file "trigonometry" :depends-on (return-structures))
(:file "zeta" :depends-on (return-structures))))
(:file "sorting" :depends-on (init data))
(:module linear-algebra
:depends-on (init data special-functions)
:components
((:file "blas1")
(:file "blas2")
(:file "blas3" :depends-on (blas2))
(:file "exponential")
(:file "lu")
(:file "qr")
(:file "qrpt")
(:file "svd")
(:file "cholesky")
(:file "diagonal")
(:file "householder")))
(:module eigensystems
:depends-on (init data)
:components
((:file "symmetric-hermitian")
(:file "nonsymmetric")
(:file "generalized")
(:file "nonsymmetric-generalized")))
;; Skip fft for now, I'm not sure how it works in C
(:module random
:depends-on (init data)
:components
((:file "rng-types")
(:file "generators" :depends-on (rng-types))
(:file "quasi" :depends-on (rng-types generators))
(:file "gaussian" :depends-on (rng-types))
(:file "gaussian-tail" :depends-on (rng-types))
(:file "gaussian-bivariate" :depends-on (rng-types))
(:file "exponential" :depends-on (rng-types))
(:file "laplace" :depends-on (rng-types))
(:file "exponential-power" :depends-on (rng-types))
(:file "cauchy" :depends-on (rng-types))
(:file "rayleigh" :depends-on (rng-types))
(:file "rayleigh-tail" :depends-on (rng-types))
(:file "landau" :depends-on (rng-types))
(:file "levy" :depends-on (rng-types))
(:file "gamma" :depends-on (rng-types))
(:file "flat" :depends-on (rng-types))
(:file "lognormal" :depends-on (rng-types))
(:file "chi-squared" :depends-on (rng-types))
(:file "fdist" :depends-on (rng-types))
(:file "tdist" :depends-on (rng-types))
(:file "beta" :depends-on (rng-types))
(:file "logistic" :depends-on (rng-types))
(:file "pareto" :depends-on (rng-types))
(:file "spherical-vector" :depends-on (rng-types))
(:file "weibull" :depends-on (rng-types))
(:file "gumbel1" :depends-on (rng-types))
(:file "gumbel2" :depends-on (rng-types))
(:file "dirichlet" :depends-on (rng-types))
(:file "discrete" :depends-on (rng-types))
(:file "poisson" :depends-on (rng-types))
(:file "bernoulli" :depends-on (rng-types))
(:file "binomial" :depends-on (rng-types))
(:file "multinomial" :depends-on (rng-types))
(:file "negative-binomial" :depends-on (rng-types))
(:file "geometric" :depends-on (rng-types))
(:file "hypergeometric" :depends-on (rng-types))
(:file "logarithmic" :depends-on (rng-types))
(:file "shuffling-sampling" :depends-on (rng-types))))
(:module statistics
:depends-on (init data)
:components
((:file "mean-variance")
(:file "absolute-deviation")
(:file "higher-moments")
(:file "autocorrelation")
(:file "covariance")
;; minimum and maximum values provided in vector.lisp
(:file "median-percentile")))
(:module histogram
:depends-on (init linear-algebra)
:components
((:file "histogram")
(:file "updating-accessing" :depends-on (histogram))
(:file "statistics" :depends-on (histogram))
(:file "operations" :depends-on (histogram))
(:file "probability-distribution" :depends-on (histogram))
(:file "ntuple")))
#+(or)
(:module calculus
:depends-on (init data random)
:components
((:file "numerical-integration")
(:file "monte-carlo")
(:file "numerical-differentiation")))
#+(or)
(:module ordinary-differential-equations
:depends-on (init)
:components
((:file "ode-system")
(:file "stepping")
(:file "control")
(:file "evolution")
(:file "ode-example" :depends-on (ode-system stepping))))
(:module interpolation
:depends-on (init)
:components
((:file "interpolation")
(:file "types" :depends-on (interpolation))
(:file "lookup")
(:file "evaluation")
(:file "spline-example" :depends-on (types))))
(:file "chebyshev" :depends-on (init))
(:file "series-acceleration" :depends-on (init))
(:file "wavelet" :depends-on (init data))
(:file "hankel" :depends-on (init data))
(:module solve-minimize-fit
:depends-on (init data random)
:components
((:file "generic")
(:file "roots-one" :depends-on (generic))
(:file "minimization-one" :depends-on (generic))
(:file "roots-multi" :depends-on (roots-one generic))
(:file "minimization-multi" :depends-on (generic))
(:file "linear-least-squares")
(:file "nonlinear-least-squares" :depends-on (generic))))
(:file "basis-splines" :depends-on (init data random))))
:name "gsll"
:description "GNU Scientific Library for Lisp."
:version "0"
:author "Liam M. Healy"
:licence "LLGPL v3, FDL"
:depends-on (cffi trivial-garbage cl-utilities)
:components
((:module init
:components
((:file "init")
(:file "forms")
(:file "conditions" :depends-on (init))
(:file "number-conversion" :depends-on (init))
(:file "callback-compile-defs" :depends-on (init))
(:file "mobject" :depends-on (init callback-compile-defs))
(:file "callback-included" :depends-on (mobject))
(:file "callback" :depends-on (init forms number-conversion callback-included))
(:file "funcallable")
(:file "types" :depends-on (init))
(:file "complex-types" :depends-on (types))
(:file "element-types" :depends-on (init complex-types))
(:file "interface"
:depends-on (init conditions element-types number-conversion))
(:file "defmfun" :depends-on (init forms element-types interface))
(:file "defmfun-array" :depends-on (defmfun callback-included))
(:file "defmfun-single" :depends-on (defmfun mobject callback))
(:file "generate-examples" :depends-on (init))))
(:module floating-point
:depends-on (init)
:components
((:file "ieee-modes")
(:file "floating-point")))
(:module mathematical
:depends-on (init)
:components
((:file "mathematical")
(:file "complex")))
(:module data
:depends-on (init)
:components
((:file "foreign-friendly")
(:file "foreign-array" :depends-on (foreign-friendly))
(:file "marray" :depends-on (foreign-array))
(:file "vector" :depends-on (marray))
(:file "matrix" :depends-on (marray vector))
(:file "maref" :depends-on (marray vector matrix))
(:file "both" :depends-on (marray vector matrix))
(:file "copy-cl")
(:file "array-tests" :depends-on (both))
(:file "permutation" :depends-on (marray))
(:file "combination" :depends-on (marray))))
(:file "polynomial" :depends-on (init data))
(:module special-functions
:depends-on (init)
:components
((:file "return-structures")
(:file "airy" :depends-on (return-structures))
(:file "bessel" :depends-on (return-structures))
(:file "clausen" :depends-on (return-structures))
(:file "coulomb" :depends-on (return-structures))
(:file "coupling" :depends-on (return-structures))
(:file "dawson" :depends-on (return-structures))
(:file "debye" :depends-on (return-structures))
(:file "dilogarithm" :depends-on (return-structures))
(:file "elementary" :depends-on (return-structures))
(:file "elliptic-integrals" :depends-on (return-structures))
(:file "elliptic-functions" :depends-on (return-structures))
(:file "error-functions" :depends-on (return-structures))
(:file "exponential-functions" :depends-on (return-structures))
(:file "exponential-integrals" :depends-on (return-structures))
(:file "fermi-dirac" :depends-on (return-structures))
(:file "gamma" :depends-on (return-structures))
(:file "gegenbauer" :depends-on (return-structures))
(:file "hypergeometric" :depends-on (return-structures))
(:file "laguerre" :depends-on (return-structures))
(:file "lambert" :depends-on (return-structures))
(:file "legendre" :depends-on (return-structures))
(:file "logarithm" :depends-on (return-structures))
(:file "mathieu" :depends-on (return-structures))
(:file "power" :depends-on (return-structures))
(:file "psi" :depends-on (return-structures))
(:file "synchrotron" :depends-on (return-structures))
(:file "transport" :depends-on (return-structures))
(:file "trigonometry" :depends-on (return-structures))
(:file "zeta" :depends-on (return-structures))))
(:file "sorting" :depends-on (init data))
(:module linear-algebra
:depends-on (init data special-functions)
:components
((:file "blas1")
(:file "blas2")
(:file "blas3" :depends-on (blas2))
(:file "exponential")
(:file "lu")
(:file "qr")
(:file "qrpt")
(:file "svd")
(:file "cholesky")
(:file "diagonal")
(:file "householder")))
(:module eigensystems
:depends-on (init data)
:components
((:file "symmetric-hermitian")
(:file "nonsymmetric")
(:file "generalized")
(:file "nonsymmetric-generalized")))
;; Skip fft for now, I'm not sure how it works in C
(:module random
:depends-on (init data)
:components
((:file "rng-types")
(:file "generators" :depends-on (rng-types))
(:file "quasi" :depends-on (rng-types generators))
(:file "gaussian" :depends-on (rng-types))
(:file "gaussian-tail" :depends-on (rng-types))
(:file "gaussian-bivariate" :depends-on (rng-types))
(:file "exponential" :depends-on (rng-types))
(:file "laplace" :depends-on (rng-types))
(:file "exponential-power" :depends-on (rng-types))
(:file "cauchy" :depends-on (rng-types))
(:file "rayleigh" :depends-on (rng-types))
(:file "rayleigh-tail" :depends-on (rng-types))
(:file "landau" :depends-on (rng-types))
(:file "levy" :depends-on (rng-types))
(:file "gamma" :depends-on (rng-types))
(:file "flat" :depends-on (rng-types))
(:file "lognormal" :depends-on (rng-types))
(:file "chi-squared" :depends-on (rng-types))
(:file "fdist" :depends-on (rng-types))
(:file "tdist" :depends-on (rng-types))
(:file "beta" :depends-on (rng-types))
(:file "logistic" :depends-on (rng-types))
(:file "pareto" :depends-on (rng-types))
(:file "spherical-vector" :depends-on (rng-types))
(:file "weibull" :depends-on (rng-types))
(:file "gumbel1" :depends-on (rng-types))
(:file "gumbel2" :depends-on (rng-types))
(:file "dirichlet" :depends-on (rng-types))
(:file "discrete" :depends-on (rng-types))
(:file "poisson" :depends-on (rng-types))
(:file "bernoulli" :depends-on (rng-types))
(:file "binomial" :depends-on (rng-types))
(:file "multinomial" :depends-on (rng-types))
(:file "negative-binomial" :depends-on (rng-types))
(:file "geometric" :depends-on (rng-types))
(:file "hypergeometric" :depends-on (rng-types))
(:file "logarithmic" :depends-on (rng-types))
(:file "shuffling-sampling" :depends-on (rng-types))))
(:module statistics
:depends-on (init data)
:components
((:file "mean-variance")
(:file "absolute-deviation")
(:file "higher-moments")
(:file "autocorrelation")
(:file "covariance")
;; minimum and maximum values provided in vector.lisp
(:file "median-percentile")))
(:module histogram
:depends-on (init linear-algebra)
:components
((:file "histogram")
(:file "updating-accessing" :depends-on (histogram))
(:file "statistics" :depends-on (histogram))
(:file "operations" :depends-on (histogram))
(:file "probability-distribution" :depends-on (histogram))
(:file "ntuple")))
(:module calculus
:depends-on (init data random)
:components
((:file "numerical-integration")
;;(:file "monte-carlo")
(:file "numerical-differentiation")))
(:module ordinary-differential-equations
:depends-on (init)
:components
((:file "ode-system")
(:file "stepping")
(:file "control")
(:file "evolution")
(:file "ode-example" :depends-on (ode-system stepping))))
(:module interpolation
:depends-on (init)
:components
((:file "interpolation")
(:file "types" :depends-on (interpolation))
(:file "lookup")
(:file "evaluation")
(:file "spline-example" :depends-on (types))))
(:file "chebyshev" :depends-on (init))
(:file "series-acceleration" :depends-on (init))
(:file "wavelet" :depends-on (init data))
(:file "hankel" :depends-on (init data))
(:module solve-minimize-fit
:depends-on (init data random)
:components
((:file "generic")
(:file "roots-one" :depends-on (generic))
(:file "minimization-one" :depends-on (generic))
(:file "roots-multi" :depends-on (roots-one generic))
(:file "minimization-multi" :depends-on (generic))
(:file "linear-least-squares")
(:file "nonlinear-least-squares" :depends-on (generic))))
(:file "basis-splines" :depends-on (init data random))))
;; Foreign callback functions.
;; Liam Healy
;; Time-stamp: <2009-03-28 20:59:14EDT callback.lisp>
;; Time-stamp: <2009-03-30 22:14:14EDT callback.lisp>
;; $Id$
(in-package :gsl)
......@@ -40,9 +40,13 @@
value))
(defun set-slot-function (foreign-structure structure-name slot-name gsl-function)
"Set the slot in the cbstruct to the callback corresponding to gsl-function.
If gsl-function is nil, set to the null-pointer."
(set-structure-slot
foreign-structure structure-name slot-name
(cffi:get-callback gsl-function)))
(if gsl-function
(cffi:get-callback gsl-function)
(cffi:null-pointer))))
(defun set-parameters (foreign-structure structure-name)
"Set the parameters slot to null."
......@@ -190,27 +194,32 @@
;;;; Form generation
;;;;****************************************************************************
(defun callback-dynamic-lister (callback-dynamic)
(mapcar (lambda (l) (cons 'list l)) callback-dynamic))
(defun callback-symbol-set (callbacks symbols)
(defun callback-symbol-set (functions 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 list in (callback-dynamic-lister callbacks)
append (list symb list))))))
for function in functions
for fnspec in (parse-callback-static callbacks 'functions)
append
`(,symb
(make-compiled-funcallable
,(first function)
',fnspec
,(second function)
,(cddr function))))))))
(defun callback-set-slots (callbacks dynamic-variables)
(when callbacks
`((set-cbstruct
,(parse-callback-static callbacks 'foreign-argument)
',(parse-callback-static callbacks 'callback-structure-type)
(mapcan 'list