diff --git a/chebyshev.lisp b/chebyshev.lisp index cb6641f1a884930a8c4fdf561685271e8213b315..7578836d7ccafbe0a143a0a1eb0ecf7c5d44f459 100644 --- a/chebyshev.lisp +++ b/chebyshev.lisp @@ -1,6 +1,6 @@ ;; Chebyshev Approximations ;; Liam Healy Sat Nov 17 2007 - 20:36 -;; Time-stamp: <2009-03-21 23:49:02EDT chebyshev.lisp> +;; Time-stamp: <2009-03-29 11:44:09EDT chebyshev.lisp> ;; $Id$ (in-package :gsl) @@ -16,7 +16,8 @@ "Chebyshev series" :documentation ; FDL "Make a Chebyshev series of specified order." - :callbacks (callback gsl-function nil (function)) + :callbacks + (callback gsl-function nil (function :double (:input :double) :slug)) :initialize-suffix "init" :initialize-args ((callback :pointer) (lower-limit :double) (upper-limit :double)) diff --git a/gsll.asd b/gsll.asd index df33ac0cf5b5b819eeb9b367d6bf3fd2093f87fe..44cc1beb5e639027b26dde8453e3a7a818b2fc66 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2009-03-22 16:58:26EDT gsll.asd> +;; Time-stamp: <2009-03-29 12:54:31EDT gsll.asd> ;; $Id$ (asdf:defsystem "gsll" @@ -21,6 +21,7 @@ (: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)) @@ -171,6 +172,7 @@ (:file "operations" :depends-on (histogram)) (:file "probability-distribution" :depends-on (histogram)) (:file "ntuple"))) + #+(or) (:module calculus :depends-on (init data random) :components diff --git a/init/funcallable.lisp b/init/funcallable.lisp index 3e375af7a23bbe6bda1da85a15993f961b1eb68f..3ea93f6ff0a3e5897064d08922a7c3dd30b5e5c2 100644 --- a/init/funcallable.lisp +++ b/init/funcallable.lisp @@ -1,6 +1,6 @@ ;; Generate a lambda that calls the user function; will be called by callback. ;; Liam Healy -;; Time-stamp: <2009-03-29 10:00:03EDT funcallable.lisp> +;; Time-stamp: <2009-03-29 12:04:35EDT funcallable.lisp> ;; $Id$ (in-package :gsl) @@ -77,14 +77,19 @@ ;; not setfable if it's a scalar foreign-variable-name)) -(defun array-element-refs (array-names argspecs dimension-values) - "A list of forms reference each array element in succession." - (loop for arg in argspecs - for count = (value-from-dimensions arg dimension-values t) - for name in array-names - append - (loop for i from 0 below count - collect (reference-foreign-element name i arg dimension-values)))) +(defun array-element-refs (names argspecs dimension-values) + "A list of forms reference each array element in succession. + If there is no argspec for the argument, just reference the variable itself." + (if argspecs + (loop for arg in argspecs + for count = (when arg (value-from-dimensions arg dimension-values t)) + for name in names + append + (if arg + (loop for i from 0 below count + collect (reference-foreign-element name i arg dimension-values)) + (list name))) + names)) (defun callback-set-mvb (argument-names form fnspec dimension-values) "Create the multiple-value-bind form in the callback to set the return C arrays." @@ -101,7 +106,6 @@ (loop for i from 0 below count collect (make-symbol-cardinal 'setscalar i))) (setvbls (array-element-refs argument-names setargs dimension-values))) - ;;(lu:print-variables setargs counts count mvbvbls setvbls) (if (zerop count) form `(multiple-value-bind ,mvbvbls @@ -142,18 +146,22 @@ (parse-callback-argspec arg 'array-type)) (list (pop oarg)) (if (eql (parse-callback-argspec arg 'io) :input) - (list (pop iarg))))))) + (list (pop iarg)))))) + (function-designator + (if (symbolp user-function) + (let ((uf user-function)) `',uf) + user-function))) `(lambda ,lambda-args ,(if (and scalarsp (or inargs-specs outargs-specs)) (let ((call-form `(funcall - ,user-function + ,function-designator ,@(array-element-refs inargs-names inargs-specs dimension-values)))) (if outargs-specs (callback-set-mvb outargs-names call-form fnspec dimension-values) ;; no specified output, return what the function returns call-form)) - `(funcall ,user-function ,@(append inargs-names outargs-names))) + `(funcall ,function-designator ,@(append inargs-names outargs-names))) ,@(case (parse-callback-fnspec fnspec 'return-spec) (:success-failure diff --git a/init/mobject.lisp b/init/mobject.lisp index eec3129433509684c5b394432f66ea097021d24e..5069dde037f310d59a38e8e1f89fd78c65ea3a0a 100644 --- a/init/mobject.lisp +++ b/init/mobject.lisp @@ -1,6 +1,6 @@ ;; Definition of GSL objects and ways to use them. ;; Liam Healy, Sun Dec 3 2006 - 10:21 -;; Time-stamp: <2009-03-29 10:04:13EDT mobject.lisp> +;; Time-stamp: <2009-03-29 12:52:22EDT mobject.lisp> ;;; GSL objects are represented in GSLL as and instance of a 'mobject. ;;; The macro demobject takes care of defining the appropriate @@ -218,7 +218,7 @@ ;; There is callback slot variable ,@(when (callback-arg-p class-slots-instance callbacks) (with-unique-names (cbs) - `((let ((,cbs (make-cbstruct-object object))) + `((let ((,cbs ,(make-cbstruct-object class))) (setf (slot-value object ',(parse-callback-static callbacks 'foreign-argument)) diff --git a/ordinary-differential-equations/ode-example.lisp b/ordinary-differential-equations/ode-example.lisp index 2710ac8ee2226a9a3ff10fb6819aec4b402a5dca..8c0d9ce95139d66a74a8569558aa0abc77c220c9 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-02-16 10:18:29EST ode-example.lisp> +;; Time-stamp: <2009-03-29 12:43:02EDT ode-example.lisp> ;; $Id$ ;;; van der Pol as given in Section 25.5 of the GSL manual. To @@ -26,8 +26,6 @@ (defparameter *max-iter* 2000) -(make-callbacks ode-stepper 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 diff --git a/ordinary-differential-equations/stepping.lisp b/ordinary-differential-equations/stepping.lisp index 1ee8e6a79830a553d6d22ab4d04e268ee17490bf..12e14b8b23bce8847858d58b31f397a79c65b6a5 100644 --- a/ordinary-differential-equations/stepping.lisp +++ b/ordinary-differential-equations/stepping.lisp @@ -1,6 +1,6 @@ ;; Stepping functions for ODE systems. ;; Liam Healy, Mon Sep 24 2007 - 21:33 -;; Time-stamp: <2009-03-23 22:25:34EDT stepping.lisp> +;; Time-stamp: <2009-03-29 12:34:49EDT stepping.lisp> ;; $Id$ ;; /usr/include/gsl/gsl_odeiv.h @@ -21,14 +21,16 @@ (callback ode-system (dimension) (function :success-failure - ((:double) ; t (independent variable), input - (:double :cvector dim0)) ; y (dependent variables), input - (:double :cvector dim0)) ; dydt, output + (:input :double) ; t (independent variable) + (:input :double :cvector dim0) ; y (dependent variables) + (:output :double :cvector dim0) ; dydt + :slug) (jacobian :success-failure - ((:double) ; t, input - (:double :cvector dim0)) ; y, input - ((:double :cvector dim0 dim0) ; dfdy, output - (:double :cvector dim0)))) ; dfdt, output + (:input :double) ; t (independent variable) + (:input :double :cvector dim0) ; y (dependent variables) + (:output :double :cvector dim0 dim0) ; dfdy + (:output :double :cvector dim0) ; dydt + :slug)) :class-slots-instance (callback) :initialize-suffix "reset" :initialize-args nil diff --git a/solve-minimize-fit/minimization-multi.lisp b/solve-minimize-fit/minimization-multi.lisp index fddaa50ef8852b1bda3223d33888b190eb5a90ea..c7938b816571297d966aeb516951808940ad6780 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-03-28 23:41:15EDT minimization-multi.lisp> +;; Time-stamp: <2009-03-29 12:43:30EDT minimization-multi.lisp> ;; $Id$ (in-package :gsl) @@ -63,14 +63,14 @@ tol |p| |g|." :callbacks (callback gsl-mfunction-fdf (dimension) - (function :double (:double :marray dim0) :slug) + (function :double (:input :double :marray dim0) :slug) (df :void - (:double :marray dim0) :slug - (:double :marray dim0 dim0)) + (:input :double :marray dim0) :slug + (:output :double :marray dim0 dim0)) (fdf :void - (:double :marray dim0) :slug - (:double :cvector dim0) - (:double :marray dim0 dim0))) + (:input :double :marray dim0) :slug + (:output :double :cvector dim0) + (:output :double :marray dim0 dim0))) :initialize-suffix "set" :initialize-args ((callback :pointer) ((mpointer initial) :pointer) @@ -355,7 +355,7 @@ (set-all step-size 1.0d0) (let ((minimizer (make-multi-dimensional-minimizer-f - method 2 ''paraboloid-scalar + method 2 'paraboloid-scalar #m(5.0d0 7.0d0) step-size))) (loop with status = T and size for iter from 0 below 100 @@ -379,8 +379,7 @@ ;;; Example using derivatives, taking a vector argument. ;;; Note that these functions are written to read objects of ;;; vector-double-float. They could as well have been written to -;;; accept the correct number of scalar double-floats, in which case -;;; the last argument to the make-callbacks form would be t. +;;; accept the correct number of scalar double-floats. (defun paraboloid-vector (gsl-vector) "A paraboloid function of two arguments, given in GSL manual Sec. 35.4. diff --git a/solve-minimize-fit/minimization-one.lisp b/solve-minimize-fit/minimization-one.lisp index eab797eaf0ba6d46b93a0e97c3255765dcd74ab8..b1bd0037ac783881703b62bb64fc1c7e912fa46c 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-03-21 23:56:38EDT minimization-one.lisp> +;; Time-stamp: <2009-03-29 12:13:30EDT minimization-one.lisp> ;; $Id$ (in-package :gsl) @@ -20,7 +20,8 @@ "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 nil (function)) + :callbacks + (callback gsl-function nil (function :double (:input :double) :slug)) :initialize-suffix "set" ; should use set_with_values? :initialize-args ((callback :pointer) (minimum :double) (lower :double) (upper :double)) @@ -180,17 +181,13 @@ ;;; This is the example given in Sec. 33.8. The results are different ;;; than given there. -(defun minimization-one-fn (x) - (1+ (cos x))) - (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." (let ((max-iter 100) (minimizer (make-one-dimensional-minimizer - minimizer-type 'minimization-one-fn - 2.0d0 0.0d0 6.0d0))) + minimizer-type (lambda (x) (1+ (cos x))) 2.0d0 0.0d0 6.0d0))) (when print-steps (format t diff --git a/solve-minimize-fit/nonlinear-least-squares.lisp b/solve-minimize-fit/nonlinear-least-squares.lisp index 8156d435c4fba8f13ba8b5c54b89ff99dce05c88..583dab1ce1e1c036f3bedb62f6b2b78b7bcd113a 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-03-22 16:09:53EDT nonlinear-least-squares.lisp> +;; Time-stamp: <2009-03-29 12:42:59EDT nonlinear-least-squares.lisp> ;; $Id$ (in-package :gsl) @@ -24,8 +24,10 @@ :callbacks (callback gsl-ffit-function (number-of-observations number-of-parameters) - (function :success-failure - (:double :marray dim1) (:double :marray dim0))) + (function + :success-failure + (:input :double :marray dim1) :slug + (:output :double :marray dim0))) :initialize-suffix "set" :initialize-args ((callback :pointer) ((mpointer initial-guess) :pointer)) :singular (function)) @@ -38,17 +40,6 @@ (number-of-parameters sizet) (parameters :pointer)) -(def-make-callbacks nonlinear-ffit - (function number-of-observations number-of-parameters &optional (scalars t)) - (if scalars - `(defmcallback ,function - :success-failure - (:double ,number-of-parameters) - ((:double ,number-of-observations)) - t ,function) - `(defmcallback ,function - :success-failure :pointer :pointer nil ,function))) - (defmfun name ((solver nonlinear-ffit)) "gsl_multifit_fsolver_name" (((mpointer solver) :pointer)) @@ -73,12 +64,18 @@ (callback gsl-fdffit-function (number-of-observations number-of-parameters) (function :success-failure - (:double :marray dim1) (:double :marray dim0)) + (:input :double :marray dim1) + :slug + (:output :double :marray dim0)) (df :success-failure - (:double :marray dim1) (:double :marray dim0 dim1)) + (:input :double :marray dim1) + :slug + (:output :double :marray dim0 dim1)) (fdf :success-failure - (:double :marray dim1) - (:double :marray dim0) (:double :marray dim0 dim1))) + (:input :double :marray dim1) + :slug + (:output :double :marray dim0) + (:output :double :marray dim0 dim1))) :initialize-suffix "set" :initialize-args ((callback :pointer) ((mpointer initial-guess) :pointer))) @@ -104,36 +101,6 @@ (number-of-parameters sizet) (parameters :pointer)) -#| -(def-make-callbacks nonlinear-fdffit - (function df fdf &optional number-of-observations number-of-parameters) - (if number-of-observations - (cl-utilities:once-only (number-of-parameters number-of-observations) - `(progn - (defmcallback ,function - :success-failure - (:double ,number-of-parameters) - ((:double ,number-of-observations)) - t ,function) - (defmcallback ,df - :success-failure - (:double ,number-of-parameters) - ((:double ,number-of-observations ,number-of-parameters)) - t ,df) - (defmcallback ,fdf - :success-failure - (:double ,number-of-parameters) - ((:double ,number-of-observations) - (:double ,number-of-observations ,number-of-parameters)) - t ,fdf))) - `(progn - (defmcallback ,function - :success-failure :pointer :pointer nil ,function) - (defmcallback ,df :success-failure :pointer :pointer nil ,df) - (defmcallback - ,fdf :success-failure :pointer (:pointer :pointer) nil ,fdf)))) -|# - (defmfun name ((solver nonlinear-fdffit)) "gsl_multifit_fdfsolver_name" (((mpointer solver) :pointer)) @@ -387,13 +354,6 @@ (exponential-residual x f) (exponential-residual-derivative x jacobian)) -#| -(make-callbacks - nonlinear-fdffit - exponential-residual exponential-residual-derivative - exponential-residual-fdf) -|# - (defun norm-f (fit) "Find the norm of the fit function f." (euclidean-norm (function-value fit))) diff --git a/solve-minimize-fit/roots-multi.lisp b/solve-minimize-fit/roots-multi.lisp index e278aa5c5085c86a765b72fad12af27474139ff0..a57162de038345258cd105f0fc77ed730112eb4d 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-03-22 00:03:35EDT roots-multi.lisp> +;;; Time-stamp: <2009-03-29 12:22:43EDT roots-multi.lisp> ;;; $Id$ (in-package :gsl) @@ -30,14 +30,16 @@ :initialize-args ((callback :pointer) ((mpointer initial) :pointer)) :callbacks (callback gsl-mfunction (dimension) - (function :success-failure - (:double :marray dim0) (:double :marray dim0))) + (function + :success-failure + (:input :double :marray dim0) :slug + (:output :double :marray dim0))) :arglists-function (lambda (set) `((type &optional function-or-dimension (initial nil ,set) (scalarsp t)) (:type type - :dimensions - (if ,set (dimensions initial) function-or-dimension)) + :dimensions + (if ,set (dimensions initial) function-or-dimension)) (:functions (list function-or-dimension) :initial initial :scalarsp scalarsp))) :inputs (initial)) @@ -56,15 +58,18 @@ :callbacks (callback gsl-mfunction-fdf (dimension) (function :success-failure - (:double :marray dim0) - (:double :marray dim0)) + (:input :double :marray dim0) + :slug + (:output :double :marray dim0)) (df :success-failure - (:double :marray dim0) - (:double :marray dim0 dim0)) + (:input :double :marray dim0) + :slug + (:output :double :marray dim0 dim0)) (fdf :success-failure - (:double :marray dim0) - (:double :marray dim0) - (:double :marray dim0 dim0))) + (:input :double :marray dim0) + :slug + (:output :double :marray dim0) + (:output :double :marray dim0 dim0))) :arglists-function (lambda (set) `((type &optional function-or-dimension (initial nil ,set) diff --git a/solve-minimize-fit/roots-one.lisp b/solve-minimize-fit/roots-one.lisp index 8a58cee6e0cc8a7fd93e70426b831ee9633bd283..21d28ccde01ce460def1db6bf6841038d45f28b6 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-03-21 23:53:41EDT roots-one.lisp> +;; Time-stamp: <2009-03-29 11:50:01EDT roots-one.lisp> ;; $Id$ (in-package :gsl) @@ -16,7 +16,8 @@ "one-dimensional root solver with function only" :initialize-suffix "set" :initialize-args ((callback :pointer) (lower :double) (upper :double)) - :callbacks (callback gsl-function nil (function)) + :callbacks + (callback gsl-function nil (function :double (:input :double) :slug)) :singular (function)) (defmobject one-dimensional-root-solver-fdf "gsl_root_fdfsolver" @@ -26,9 +27,10 @@ :initialize-args ((callback :pointer) (root-guess :double)) :callbacks (callback gsl-function-fdf nil - (function) - (df) - (fdf :void :double (:double :cvector 1) (:double :cvector 1))) + (function :double (:input :double) :slug) + (df :double (:input :double) :slug) + (fdf :void (:input :double) :slug + (:output :double :cvector 1) (:output :double :cvector 1))) :arglists-function (lambda (set) `((type &optional (function nil ,set) df fdf root-guess)