diff --git a/init/init.lisp b/init/init.lisp index 6a59273a172f0be48654203f440ec7dd845133e4..0c606ffa8d3030296fe9203cf3f3c9455ac99c1d 100644 --- a/init/init.lisp +++ b/init/init.lisp @@ -1,6 +1,6 @@ ;; Load GSL ;; Liam Healy Sat Mar 4 2006 - 18:53 -;; Time-stamp: <2009-01-24 18:07:19EST init.lisp> +;; Time-stamp: <2009-01-26 21:39:39EST init.lisp> ;; $Id$ (defpackage gsll @@ -39,6 +39,10 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (pushnew :native *features*)) +#+openmcl +(eval-when (:compile-toplevel :load-toplevel :execute) + (pushnew :callback-toplevel-only *features*)) + ;;; CFFI currently doesn't allow uninterned callback names for CCL; ;;; patch here. diff --git a/ordinary-differential-equations/evolution.lisp b/ordinary-differential-equations/evolution.lisp index 2d8832b5acb413ec434071bd0cf022fdf6b98824..0b1101ccd3db1e29789d7df8ed85794165b1c037 100644 --- a/ordinary-differential-equations/evolution.lisp +++ b/ordinary-differential-equations/evolution.lisp @@ -1,6 +1,6 @@ ;; Evolution functions for ODE integration. ;; Liam Healy, Sun Sep 30 2007 - 14:31 -;; Time-stamp: <2009-01-25 17:52:45EST evolution.lisp> +;; Time-stamp: <2009-01-26 21:25:15EST evolution.lisp> ;; $Id$ (in-package :gsl) @@ -21,6 +21,8 @@ (dydt :pointer) ((c-pointer time) :pointer) (max-time :double) ((c-pointer step-size) :pointer) ((c-pointer y) :pointer)) + :inputs (time step-size y) + :outputs (time step-size y) :documentation ; FDL "Advance the system (e, dydt) from time and position y using the stepping function step. diff --git a/ordinary-differential-equations/ode-example.lisp b/ordinary-differential-equations/ode-example.lisp index e9724c10d9394fc028a174e95bf39927242ee2a5..383ff2ed65e8fe4d6096b27553b7fb349c7a57d9 100644 --- a/ordinary-differential-equations/ode-example.lisp +++ b/ordinary-differential-equations/ode-example.lisp @@ -1,6 +1,6 @@ ;; Example ODE ;; Liam Healy Sat Sep 29 2007 - 17:49 -;; Time-stamp: <2009-01-25 19:15:39EST ode-example.lisp> +;; Time-stamp: <2009-01-26 21:45:43EST ode-example.lisp> ;; $Id$ ;;; van der Pol as given in Section 25.5 of the GSL manual. To @@ -26,6 +26,10 @@ (defparameter *max-iter* 2000) +#+callback-toplevel-only +(defparameter *vanderpol-cb* + (make-ode-functions vanderpol vanderpol-jacobian 2)) + (defun integrate-vanderpol (max-time &optional (step-size 1.0d-6) (stepper *step-rk8pd*) (print-steps t)) "Integrate the van der Pol oscillator as given in Section 25.5 of the @@ -33,7 +37,9 @@ (let ((mu 10.0d0) (initial-time 0.0d0) (iter 0)) (declare (special mu)) (with-ode-integration - ((make-ode-functions vanderpol vanderpol-jacobian 2) + (#-callback-toplevel-only + (make-ode-functions vanderpol vanderpol-jacobian 2) + #+callback-toplevel-only *vanderpol-cb* time step max-time (dep0 dep1) 2 stepper) (setf dep0 1.0d0 dep1 0.0d0 step step-size time initial-time) (loop diff --git a/series-acceleration.lisp b/series-acceleration.lisp index 6474bb6aec98440976e9f3550760600c120143d8..b5ea3abffee999228586b295bd289caec2ac5da0 100644 --- a/series-acceleration.lisp +++ b/series-acceleration.lisp @@ -1,6 +1,6 @@ ;; Series acceleration. ;; Liam Healy, Wed Nov 21 2007 - 18:41 -;; Time-stamp: <2009-01-25 10:12:17EST series-acceleration.lisp> +;; Time-stamp: <2009-01-26 21:31:38EST series-acceleration.lisp> ;; $Id$ (in-package :gsl) @@ -37,6 +37,7 @@ "gsl_sum_levin_u_accel" (((c-pointer array) :pointer) ((dim0 array) sizet) ((mpointer levin) :pointer) (accelerated-sum :double) (absolute-error :double)) + :inputs (array) :documentation ; FDL "From the terms of a series in array, compute the extrapolated limit of the series using a Levin u-transform. Additional @@ -64,6 +65,7 @@ "gsl_sum_levin_utrunc_accel" (((c-pointer array) :pointer) ((dim0 array) sizet) ((mpointer levin) :pointer) (accelerated-sum :double) (absolute-error :double)) + :inputs (array) :documentation ; FDL "From the terms of a series in array, compute the extrapolated limit of the series using a Levin u-transform. Additional diff --git a/solve-minimize-fit/minimization-multi.lisp b/solve-minimize-fit/minimization-multi.lisp index 5a2f6c17238ecdb2bfaf3e4275f96df9b218cb62..e38b02537ceff8715fcee6b9f06b2f366b995532 100644 --- a/solve-minimize-fit/minimization-multi.lisp +++ b/solve-minimize-fit/minimization-multi.lisp @@ -1,6 +1,6 @@ ;; Multivariate minimization. ;; Liam Healy <Tue Jan 8 2008 - 21:28> -;; Time-stamp: <2009-01-25 10:09:46EST minimization-multi.lisp> +;; Time-stamp: <2009-01-26 21:55:26EST minimization-multi.lisp> ;; $Id$ (in-package :gsl) @@ -191,6 +191,7 @@ (defmfun min-test-gradient (gradient absolute-error) "gsl_multimin_test_gradient" (((mpointer gradient) :pointer) (absolute-error :double)) + :inputs (gradient) :c-return :success-continue :documentation ; FDL "Test the norm of the gradient against the @@ -319,15 +320,23 @@ (parabaloid-derivative arguments-gv-pointer derivative-gv-pointer))) +#+callback-toplevel-only +(defparameter *minmultidf-cb* + (make-minimization-functions + parabaloid-vector 2 + parabaloid-derivative parabaloid-and-derivative t)) + (defun multimin-example-derivative (&optional (method *conjugate-fletcher-reeves*) (print-steps t)) (let* ((initial #m(5.0d0 7.0d0)) (minimizer (make-multi-dimensional-minimizer-fdf method 2 + #-callback-toplevel-only (make-minimization-functions parabaloid-vector 2 parabaloid-derivative parabaloid-and-derivative t) + #+callback-toplevel-only *minmultidf-cb* initial 0.01d0 1.0d-4))) (loop with status = T for iter from 0 below 100 @@ -360,6 +369,10 @@ (* 20 (expt (- y dp1) 2)) 30))) +#+callback-toplevel-only +(defparameter *minmulti-cb* + (make-minimization-functions parabaloid-scalar 2)) + (defun multimin-example-no-derivative (&optional (method *simplex-nelder-mead*) (print-steps t)) (let ((step-size (make-marray 'double-float :dimensions 2))) @@ -367,7 +380,9 @@ (let ((minimizer (make-multi-dimensional-minimizer-f method 2 + #-callback-toplevel-only (make-minimization-functions parabaloid-scalar 2) + #+callback-toplevel-only *minmulti-cb* #m(5.0d0 7.0d0) step-size))) (loop with status = T and size for iter from 0 below 100 diff --git a/solve-minimize-fit/minimization-one.lisp b/solve-minimize-fit/minimization-one.lisp index bb1c6445e8dda6b52c599eaf94c6ce8bd525dbaa..7de2394f1f1d66bc9304009d6884bafb640a830e 100644 --- a/solve-minimize-fit/minimization-one.lisp +++ b/solve-minimize-fit/minimization-one.lisp @@ -1,6 +1,6 @@ ;; Univariate minimization ;; Liam Healy Tue Jan 8 2008 - 21:02 -;; Time-stamp: <2009-01-25 10:07:59EST minimization-one.lisp> +;; Time-stamp: <2009-01-26 21:40:02EST minimization-one.lisp> ;; $Id$ (in-package :gsl) @@ -180,6 +180,9 @@ (defun minimization-one-fn (x) (1+ (cos x))) +#+callback-toplevel-only +(defparameter *minone-cb* (make-single-function minimization-one-fn)) + (defun minimization-one-example (&optional (minimizer-type *brent-fminimizer*) (print-steps t)) "Solving a minimum, the example given in Sec. 33.8 of the GSL manual." @@ -187,7 +190,8 @@ (minimizer (make-one-dimensional-minimizer minimizer-type - (make-single-function minimization-one-fn) + #-callback-toplevel-only (make-single-function minimization-one-fn) + #+callback-toplevel-only *minone-cb* 2.0d0 0.0d0 6.0d0))) (when print-steps (format diff --git a/solve-minimize-fit/nonlinear-least-squares.lisp b/solve-minimize-fit/nonlinear-least-squares.lisp index 7f2aa9543396ba6208e686cb9269f0c084aff647..07bde5851f197670256a8ca615ec75c2558a2251 100644 --- a/solve-minimize-fit/nonlinear-least-squares.lisp +++ b/solve-minimize-fit/nonlinear-least-squares.lisp @@ -1,6 +1,6 @@ ;; Nonlinear least squares fitting. ;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp -;; Time-stamp: <2009-01-25 10:11:21EST nonlinear-least-squares.lisp> +;; Time-stamp: <2009-01-26 21:43:22EST nonlinear-least-squares.lisp> ;; $Id$ (in-package :gsl) @@ -372,15 +372,23 @@ "Find the norm of the fit function f." (euclidean-norm (function-value fit))) +#+callback-toplevel-only +(defparameter *fitting-cb* + (make-fitting-functions + exponential-residual 3 40 + exponential-residual-derivative exponential-residual-fdf)) + (defun nonlinear-least-squares-example (&optional (number-of-observations 40) (method *levenberg-marquardt*) (print-steps t)) (let ((*nlls-example-data* (generate-nlls-data number-of-observations)) (nlls-callback - (make-fitting-functions - exponential-residual 3 number-of-observations - exponential-residual-derivative exponential-residual-fdf))) + #-callback-toplevel-only + (make-fitting-functions + exponential-residual 3 number-of-observations + exponential-residual-derivative exponential-residual-fdf) + #+callback-toplevel-only *fitting-cb*)) (setf (number-of-observations nlls-callback) number-of-observations) (let* ((init #m(1.0d0 0.0d0 0.0d0)) (number-of-parameters (number-of-parameters nlls-callback)) diff --git a/solve-minimize-fit/roots-multi.lisp b/solve-minimize-fit/roots-multi.lisp index 1a861673e9b0364a495c87c76dc436d970f658b1..fe13aee2adefa38188b17522aa040cf067afac8b 100644 --- a/solve-minimize-fit/roots-multi.lisp +++ b/solve-minimize-fit/roots-multi.lisp @@ -1,6 +1,6 @@ ;;; Multivariate roots. ;;; Liam Healy 2008-01-12 12:49:08 -;;; Time-stamp: <2009-01-25 10:06:14EST roots-multi.lisp> +;;; Time-stamp: <2009-01-26 21:45:23EST roots-multi.lisp> ;;; $Id$ (in-package :gsl) @@ -360,12 +360,19 @@ (* *rosenbrock-a* (- 1 arg0)) (* *rosenbrock-b* (- arg1 (expt arg0 2))))) +#+callback-toplevel-only +(defparameter *solver-nodf-cb* + (make-solver-functions rosenbrock nil nil 2)) + (defun roots-multi-example-no-derivative (&optional (method *hybrid-scaled*) (print-steps t)) "Solving Rosenbrock, the example given in Sec. 34.8 of the GSL manual." (let ((max-iter 1000) (solver (make-multi-dimensional-root-solver-f - method (make-solver-functions rosenbrock nil nil 2) + method + #-callback-toplevel-only + (make-solver-functions rosenbrock nil nil 2) + #+callback-toplevel-only *solver-nodf-cb* #m(-10.0d0 -5.0d0)))) (loop for iter from 0 with fnval and argval @@ -404,6 +411,10 @@ (rosenbrock-df arg0 arg1) (values v0 v1 j0 j1 j2 j3)))) +#+callback-toplevel-only +(defparameter *solver-df-cb* + (make-solver-functions rosenbrock rosenbrock-df rosenbrock-fdf 2)) + (defun roots-multi-example-derivative (&optional (method *gnewton-mfdfsolver*) (print-steps t)) "Solving Rosenbrock with derivatives, the example given in Sec. 34.8 of the GSL manual." @@ -418,7 +429,9 @@ (let ((max-iter 1000) (solver (make-multi-dimensional-root-solver-fdf method + #-callback-toplevel-only (make-solver-functions rosenbrock rosenbrock-df rosenbrock-fdf 2) + #+callback-toplevel-only *solver-df-cb* #m(-10.0d0 -5.0d0)))) (loop for iter from 0 with fnval = (function-value solver) diff --git a/solve-minimize-fit/roots-one.lisp b/solve-minimize-fit/roots-one.lisp index 105ef26639e73ddedde76e84cfe8ea4aa05a38a9..7acc8d77d7259d7aecdb96300f4872534a4eef5a 100644 --- a/solve-minimize-fit/roots-one.lisp +++ b/solve-minimize-fit/roots-one.lisp @@ -1,6 +1,6 @@ ;; One-dimensional root solver. ;; Liam Healy -;; Time-stamp: <2009-01-25 10:10:24EST roots-one.lisp> +;; Time-stamp: <2009-01-26 21:44:26EST roots-one.lisp> ;; $Id$ (in-package :gsl) @@ -280,13 +280,20 @@ (values (+ (* (+ (* a x) b) x) c) (+ (* 2 a x) b)))) +#+callback-toplevel-only +(defparameter *roots-one-noderiv-cb* + (make-single-function quadratic)) + (defun roots-one-example-no-derivative (&optional (method *brent-fsolver*) (print-steps t)) "Solving a quadratic, the example given in Sec. 32.10 of the GSL manual." (let ((max-iter 50) (solver (make-one-dimensional-root-solver-f - method (make-single-function quadratic) 0.0d0 5.0d0))) + method + #-callback-toplevel-only (make-single-function quadratic) + #+callback-toplevel-only *roots-one-noderiv-cb* + 0.0d0 5.0d0))) (when print-steps (format t "iter ~6t [lower ~24tupper] ~36troot ~44terr ~54terr(est)~&")) (loop for iter from 0 @@ -304,6 +311,11 @@ (- upper lower))) finally (return root)))) +#+callback-toplevel-only +(defparameter *roots-one-deriv-cb* + (make-solver-functions + quadratic quadratic-derivative quadratic-and-derivative)) + (defun roots-one-example-derivative (&optional (method *newton-fdfsolver*) (print-steps t)) "Solving a quadratic, the example given in Sec. 32.10 of the GSL manual." @@ -311,8 +323,11 @@ (initial 5.0d0) (solver (make-one-dimensional-root-solver-fdf method + #-callback-toplevel-only (make-solver-functions quadratic quadratic-derivative quadratic-and-derivative) + #+callback-toplevel-only + *roots-one-deriv-cb* initial))) (when print-steps (format t "iter ~6t ~8troot ~22terr ~34terr(est)~&")) diff --git a/test-unit/additional-definitions.lisp b/test-unit/additional-definitions.lisp index 7f3eb1c4743c7ab95c4278af403b886e895e902b..04846f6e85ac00b600a64844c3b8c501a797833a 100644 --- a/test-unit/additional-definitions.lisp +++ b/test-unit/additional-definitions.lisp @@ -1,11 +1,7 @@ -;******************************************************** -; file: tests.lisp -; description: Test functions. -; date: Sat Apr 22 2006 - 16:52 -; author: Liam M. Healy -; modified: Tue Jul 18 2006 - 22:36 -;******************************************************** -;;; $Id$ +;; Test functions. +;; Liam Healy Sat Apr 22 2006 - 16:52 +;; Time-stamp: <2009-01-26 21:34:35EST additional-definitions.lisp> +;; $Id: $ ;;; Interface with lisp-unit, add a definition for comparing floating ;;; point numbers and a form for generating floating point tests.