From 0d2f9357a2b7b9f22ca8c1b26f6bdb775cb0fc68 Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Thu, 25 Dec 2008 14:34:48 -0500 Subject: [PATCH] Complete definition of GSL objects with defmobject Defined make-load-form method for data. For histogram and random number generators, old code has been removed. Nothing has been compiled. --- data/data.lisp | 13 +- eigensystems.lisp | 38 ++- histogram/histogram.lisp | 234 +++++-------------- histogram/probability-distribution.lisp | 123 +++------- init/gsl-objects.lisp | 47 ++-- init/interface.lisp | 7 +- interpolation/lookup.lisp | 4 +- monte-carlo.lisp | 36 ++- numerical-integration.lisp | 10 +- polynomial.lisp | 9 +- random/discrete.lisp | 15 +- random/generators.lisp | 112 ++------- random/quasi.lisp | 71 ++---- solve-minimize-fit/linear-least-squares.lisp | 10 +- solve-minimize-fit/minimization-multi.lisp | 35 ++- solve-minimize-fit/minimization-one.lisp | 15 +- solve-minimize-fit/roots-multi.lisp | 38 ++- solve-minimize-fit/roots-one.lisp | 6 +- 18 files changed, 380 insertions(+), 443 deletions(-) diff --git a/data/data.lisp b/data/data.lisp index 1a51583d..e77f8d34 100644 --- a/data/data.lisp +++ b/data/data.lisp @@ -1,7 +1,7 @@ ;; "Data" is bulk arrayed data, like vectors, matrices, permutations, ;; combinations, or histograms. ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2008-12-21 17:58:34EST data.lisp> +;; Time-stamp: <2008-12-25 09:40:55EST data.lisp> ;; $Id$ (in-package :gsl) @@ -66,6 +66,17 @@ #-native (copy-c-to-cl object) (princ (cl-array object) stream))) +(defmethod make-load-form ((object gsl-data) &optional env) + (declare (ignore env)) + `(make-array* + ',(element-type object) + :initial-contents + ',(loop for elt across + (subseq (original-array object) + (offset object) + (+ (offset object) (total-size object))) + collect elt))) + (defun dim0 (object) "The first dimension of the object." (first (dimensions object))) diff --git a/eigensystems.lisp b/eigensystems.lisp index a907e069..2ee0d80a 100644 --- a/eigensystems.lisp +++ b/eigensystems.lisp @@ -1,6 +1,6 @@ ;; Eigenvectors and eigenvalues ;; Liam Healy, Sun May 21 2006 - 19:52 -;; Time-stamp: <2008-11-30 23:37:31EST eigensystems.lisp> +;; Time-stamp: <2008-12-25 11:28:44EST eigensystems.lisp> ;; $Id$ (in-package :gsl) @@ -9,6 +9,15 @@ ;;;; Workspace ;;;;**************************************************************************** +#| +(defmobject eigen-symm + "gsl_eigen_symm" ((n sizet)) + "symmetric eigenvalue workspace" ; FDL + "Make a workspace for computing eigenvalues of + n-by-n real symmetric matrices. The size of the workspace + is O(2n).") +|# + (defgo-s (eigen-symm n) eigen-symm-alloc eigen-symm-free) (defmfun eigen-symm-alloc (n) @@ -29,6 +38,15 @@ :documentation ; FDL "Free the memory associated with the workspace w.") +#| +(defmobject eigen-symmv + "gsl_eigen_symmv" ((n sizet)) + "symmetric eigensystem workspace" ; FDL + "Make a workspace for computing eigenvalues and + eigenvectors of n-by-n real symmetric matrices. The size of + the workspace is O(4n).") +|# + (defgo-s (eigen-symmv n) eigen-symmv-alloc eigen-symmv-free) (defmfun eigen-symmv-alloc (n) @@ -48,6 +66,15 @@ :documentation ; FDL "Free the memory associated with the workspace w.") +#| +(defmobject eigen-herm + "gsl_eigen_herm" ((n sizet)) + "Hermitian eigenvalue workspace" ; FDL + "Make a workspace for computing eigenvalues of + n-by-n complex Hermitian matrices. The size of the workspace + is O(3n).") +|# + (defgo-s (eigen-herm n) eigen-herm-alloc eigen-herm-free) (defmfun eigen-herm-alloc (n) @@ -64,6 +91,15 @@ :documentation ; FDL "Free the memory associated with the workspace w.") +#| +(defmobject eigen-hermv + "gsl_eigen_hermv" ((n sizet)) + "Hermitian eigensystem workspace" ; FDL + "Make a workspace for computing eigenvalues and + eigenvectors of n-by-n complex hermitian matrices. The size of + the workspace is O(5n).") +|# + (defgo-s (eigen-hermv n) eigen-hermv-alloc eigen-hermv-free) (defmfun eigen-hermv-alloc (n) diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp index b27b5216..1952c494 100644 --- a/histogram/histogram.lisp +++ b/histogram/histogram.lisp @@ -1,131 +1,40 @@ ;; The histogram structure ;; Liam Healy, Mon Jan 1 2007 - 11:32 -;; Time-stamp: <2008-11-16 13:46:24EST histogram.lisp> +;; Time-stamp: <2008-12-25 14:30:48EST histogram.lisp> ;; $Id$ (in-package :gsl) ;;; Define, make, copy histograms in one or two dimensions. -(defgo histogram (size &rest from-or-ranges) - (list `(make-histogram ,size - ,(when from-or-ranges - `(when (typep (first ,from-or-ranges) 'histogram) - (first ,from-or-ranges)))) - 'free - (when from-or-ranges - (lambda (sym) - `(unless (typep (first ,from-or-ranges) 'histogram) - (set-ranges ,sym ,@from-or-ranges)))))) - -(defclass histogram () - ((pointer - :initarg :pointer :accessor mpointer - :documentation "A C pointer to the GSL representation of the histogram.") - (number-of-bins :initarg :number-of-bins :accessor number-of-bins)) - (:documentation - "A histogram, including bin boundaries and bin contents.")) - -(defun assign-pointer (object pointer) - "Check that a GSL data pointer is not null, then assign it to the object." - (check-null-pointer - pointer - 'memory-allocation-failure - (format nil "for ~a." - (with-output-to-string (stream) (princ object stream)))) - (setf (mpointer object) pointer)) - -(defmfun alloc-histo-1 (object) - "gsl_histogram_alloc" - (((number-of-bins object) sizet)) - :export nil - :index (letm histogram) - :c-return (cr :pointer) - :return ((assign-pointer object cr))) - -(defmfun alloc-histo-2 (object) - "gsl_histogram2d_alloc" - (((first (number-of-bins object)) sizet) - ((second (number-of-bins object)) sizet)) - :export nil - :index (letm histogram) - :c-return (cr :pointer) - :return ((assign-pointer object cr))) - -(defmacro histo-1d2d - (object base-function-name &optional args1 args2) - `(if (listp (number-of-bins ,object)) - (,(intern - (concatenate 'string (string base-function-name) "-2")) - ,object ,@(or args2 args1)) - (,(intern - (concatenate 'string (string base-function-name) "-1")) - ,object ,@args1))) - -(defmethod alloc ((object histogram)) - (histo-1d2d object alloc-histo)) - -(defmfun free-histo-1 (object) - "gsl_histogram_free" - (((mpointer object) :pointer)) - :c-return :void - :export nil - :index (letm histogram)) - -(defmfun free-histo-2 (object) - "gsl_histogram2d_free" - (((mpointer object) :pointer)) - :c-return :void - :export nil - :index (letm histogram)) - -(defmethod free ((object histogram)) - (histo-1d2d object free-histo)) +;; /usr/include/gsl/gsl_histogram.h +;; /usr/include/gsl/gsl_histogram2d.h + +(defmobject histogram + "gsl_histogram" + ((number-of-bins sizet)) + "one-dimensional histogram, including bin boundaries and bin contents." + NIL + "set_ranges" + (((c-pointer ranges) :pointer) ((dim0 ranges) sizet))) + +(defmobject histogram2d + "gsl_histogram2d" + ((number-of-bins-x sizet) (number-of-bins-y sizet)) + "two-dimensional histogram, including bin boundaries and bin contents." + NIL + "set_ranges" + (((c-pointer x-ranges) :pointer) ((dim0 x-ranges) sizet) + ((c-pointer y-ranges) :pointer) ((dim0 y-ranges) sizet))) ;;; GSL documentation does not state what the return value for the -;;; C function means; assumed to be error code. -(defmfun set-ranges-1 (histogram ranges) - "gsl_histogram_set_ranges" - (((mpointer histogram) :pointer) - ((c-pointer ranges) :pointer) ((dim0 ranges) sizet)) - :export nil - :index (letm histogram) - :documentation ; FDL - "Set the ranges of the existing histogram using - the gsl-vector of ranges. The values of the histogram - bins are reset to zero. The ranges array should contain the - desired bin limits. The ranges can be arbitrary, subject to the - restriction that they are monotonically increasing.") +;;; C function for reinitialization means; assumed to be error code. -(defmfun set-ranges-2 (histogram x-ranges y-ranges) - "gsl_histogram2d_set_ranges" - (((mpointer histogram) :pointer) - ((c-pointer x-ranges) :pointer) ((dim0 x-ranges) sizet) - ((c-pointer y-ranges) :pointer) ((dim0 y-ranges) sizet)) - :export nil - :index (letm histogram)) - -(export 'set-ranges) -(defun set-ranges (histogram &rest ranges) - "Set the ranges of the existing histogram using - the gsl-vector(s) of ranges. The values of the histogram - bins are reset to zero. The ranges array(s) should contain the - desired bin limits. The ranges can be arbitrary, subject to the - restriction that they are monotonically increasing. - For a 2d histogram, supply two gsl-vectors." - (histo-1d2d histogram set-ranges - ((first ranges)) - ((first ranges) (second ranges)))) - -;;; GSL documentation does not state what the return value for the -;;; C function means; assumed to be error code. -(defmfun set-ranges-uniform-1 (histogram minimum maximum) - "gsl_histogram_set_ranges_uniform" - (((mpointer histogram) :pointer) (minimum :double) (maximum :double)) - :export nil - :index set-ranges-uniform - :documentation ; FDL - "Set the ranges of the existing histogram h to cover +(export 'set-ranges-uniform) +(defgeneric set-ranges-uniform + (histogram minimum maximum &optional minimum2 maximum2 ) + (:documentation ;; FDL + "Set the ranges of the existing histogram h to cover the range xmin to xmax uniformly. The values of the histogram bins are reset to zero. The bin ranges are shown in the table below, @@ -133,87 +42,68 @@ bin[1] corresponds to xmin + d <= x < xmin + 2 d ...... bin[n-1] corresponds to xmin + (n-1)d <= x < xmax - where d is the bin spacing, d = (xmax-xmin)/n.") + where d is the bin spacing, d = (xmax-xmin)/n.")) + +;;; GSL documentation does not state what the return value for the +;;; C function for set-ranges-uniform means; assumed to be error code. +(defmfun set-ranges-uniform ((histogram histogram) minimum maximum) + "gsl_histogram_set_ranges_uniform" + (((mpointer histogram) :pointer) (minimum :double) (maximum :double)) + :definition :method + :return (histogram)) ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun set-ranges-uniform-2 - (histogram x-minimum x-maximum y-minimum y-maximum) +(defmfun set-ranges-uniform + ((histogram histogram2d) x-minimum x-maximum &optional y-minimum y-maximum) "gsl_histogram2d_set_ranges_uniform" (((mpointer histogram) :pointer) (x-minimum :double) (x-maximum :double) (y-minimum :double) (y-maximum :double)) - :export nil - :index set-ranges-uniform) - -(export 'set-ranges-uniform) -(defun set-ranges-uniform (histogram &rest limits) - ;; FDL - "Set the ranges of the existing histogram h to cover - the range xmin to xmax uniformly. The values of the - histogram bins are reset to zero. The bin ranges are shown in the table - below, - bin[0] corresponds to xmin <= x < xmin + d - bin[1] corresponds to xmin + d <= x < xmin + 2 d - ...... - bin[n-1] corresponds to xmin + (n-1)d <= x < xmax - where d is the bin spacing, d = (xmax-xmin)/n." - (histo-1d2d histogram set-ranges-uniform - ((first limits) (second limits)) - ((first limits) (second limits) - (third limits) (fourth limits)))) + :definition :method + :return (histogram)) -(defmfun copy-1 (destination source) +(defmfun copy ((destination histogram) (source histogram)) "gsl_histogram_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) - :export nil - :index copy + :definition :method + :return (destination) :documentation ; FDL "Copy the histogram source into the pre-existing histogram destination, making the latter into an exact copy of the former. The two histograms must be of the same size.") -(defmfun copy-2 (destination source) +(defmfun copy ((destination histogram2d) (source histogram2d)) "gsl_histogram2d_memcpy" (((mpointer destination) :pointer) ((mpointer source) :pointer)) - :export nil - :index copy) + :definition :method + :return (destination) + :documentation ; FDL + "Copy the histogram source into the pre-existing + histogram destination, making the latter into + an exact copy of the former. + The two histograms must be of the same size.") -(defmethod copy ((destination histogram) (source histogram)) - (histo-1d2d destination copy (source))) +;;; Could be part of copy when the second argument is optional? +(export 'clone) +(defgeneric clone (object) + (:documentation "Create a duplicate object.")) -(defmfun clone-1 (source) - "gsl_histogram_memcpy" +;;; This returns a bare C pointer, which isn't too useful. +(defmfun clone ((source histogram)) + "gsl_histogram_clone" (((mpointer source) :pointer)) - :export nil - :index clone + :c-return :pointer + :definition :method :documentation ; FDL "Create a new histogram which is an exact copy of the histogram source, and return the pointer.") -(defmfun clone-2 (source) - "gsl_histogram2d_memcpy" +(defmfun clone (source) + "gsl_histogram2d_clone" (((mpointer source) :pointer)) - :export nil - :index clone + :definition :method :documentation ; FDL "Create a new histogram which is an exact copy of the histogram source, and return the pointer.") - -(export 'clone) -(defun clone (source) - ;; FDL - "Create a new histogram which is an - exact copy of the histogram source, and return the pointer." - (histo-1d2d source clone)) - -(defun make-histogram (size &optional from) - "Make a histogram, optionally filling it with - data from an existing histogram." - (let ((ret - (make-instance 'histogram :number-of-bins size - :pointer (when from (clone from))))) - (unless (mpointer ret) - (alloc ret)) - ret)) diff --git a/histogram/probability-distribution.lisp b/histogram/probability-distribution.lisp index 580628c1..ebd4701b 100644 --- a/histogram/probability-distribution.lisp +++ b/histogram/probability-distribution.lisp @@ -1,113 +1,54 @@ ;; Histogram probability distribution. ;; Liam Healy, Mon Jan 1 2007 - 17:51 -;; Time-stamp: <2008-11-16 13:26:02EST probability-distribution.lisp> +;; Time-stamp: <2008-12-25 13:06:55EST probability-distribution.lisp> ;; $Id$ (in-package :gsl) -(defclass histogram-pdf () - ((pointer - :initarg :pointer :accessor mpointer - :documentation - "A C pointer to the GSL representation of the histogram.") - (number-of-bins :initarg :number-of-bins :accessor number-of-bins)) - (:documentation - "A histogram, including bin boundaries and bin contents.")) +;; /usr/include/gsl/gsl_histogram.h +;; /usr/include/gsl/gsl_histogram2d.h -(defmfun alloc-1 (object) - "gsl_histogram_pdf_alloc" - (((number-of-bins object) sizet)) - :export nil - :index alloc - :c-return (cr :pointer) - :return ((assign-pointer object cr))) - -(defmfun alloc-2 (object) - "gsl_histogram2d_pdf_alloc" - (((number-of-bins object) sizet)) - :export nil - :index alloc - :c-return (cr :pointer) - :return ((assign-pointer object cr))) - -(defmethod alloc ((object histogram-pdf)) - (histo-1d2d object alloc)) - -(defmfun free-1 (object) - "gsl_histogram_pdf_free" - (((mpointer object) :pointer)) - :export nil - :index free - :c-return :void) - -(defmfun free-2 (object) - "gsl_histogram2d_pdf_free" - (((mpointer object) :pointer)) - :export nil - :index free - :c-return :void) - -(defmethod free ((object histogram-pdf)) - (histo-1d2d object free)) - -(defmfun pdf-init-1 (pdf histogram) - "gsl_histogram_pdf_init" - (((mpointer pdf) :pointer) ((mpointer histogram) :pointer)) - :return () - :export nil - :index pdf-init - :documentation ; FDL - "Initialize the probability distribution pdf with the contents +(defmobject histogram-pdf + "gsl_histogram_pdf" + ((number-of-bins sizet)) + "one-dimensional histogram PDF" + "Optionally initialize the probability distribution pdf with the contents of the histogram. If any of the bins are negative then an input-domain error is signalled because a probability distribution - cannot contain negative values.") - -(defmfun pdf-init-2 (pdf histogram) - "gsl_histogram2d_pdf_init" - (((mpointer pdf) :pointer) ((mpointer histogram) :pointer)) - :return () - :export nil - :index pdf-init - :documentation ; FDL - "Initialize the probability distribution pdf with the contents - of the histogram. If any of the bins are negative then an - input-domain error is signalled because a probability distribution - cannot contain negative values.") - -(export 'pdf-init) -(defun pdf-init (pdf histogram) ; FDL - "Initialize the probability distribution pdf with the contents + cannot contain negative values." + "init" + (((mpointer histogram) :pointer))) + +(defmobject histogram2d-pdf + "gsl_histogram2d_pdf" + ((number-of-bins-x sizet) (number-of-bins-y sizet)) + "two-dimensional histogram PDF" + "Optionally initialize the probability distribution pdf with the contents of the histogram. If any of the bins are negative then an input-domain error is signalled because a probability distribution cannot contain negative values." - (histo-1d2d pdf pdf-init (histogram))) + "init" + (((mpointer histogram) :pointer))) -(defmfun sample-1 (pdf value) - "gsl_histogram_pdf_sample" - (((mpointer pdf) :pointer) (value :double)) - :c-return :double - :export nil - :index sample - :documentation ; FDL - "Given a uniform random number between zero and one, +(export 'sample) +(defgeneric sample (pdf value) + (:documentation ;; FDL + "Given a uniform random number between zero and one, compute a single random sample from the probability distribution 'pdf. The algorithm used to compute the sample s is given by s = range[i] + delta * (range[i+1] - range[i]) where i is the index which satisfies sum[i] <= r < sum[i+1] and delta is - (r - sum[i])/(sum[i+1] - sum[i]).") + (r - sum[i])/(sum[i+1] - sum[i]).")) + +(defmfun sample ((pdf histogram-pdf) value) + "gsl_histogram_pdf_sample" + (((mpointer pdf) :pointer) (value :double)) + :definition :method + :c-return :double) (defmfun sample-2 (pdf value) "gsl_histogram2d_pdf_sample" (((mpointer pdf) :pointer) (value :double)) - :c-return :double - :export nil - :index sample - :documentation ; FDL - "Given a uniform random number between zero and one, - compute a single random sample from the probability distribution - 'pdf. The algorithm used to compute the sample s is given by - s = range[i] + delta * (range[i+1] - range[i]) - where i is the index which satisfies - sum[i] <= r < sum[i+1] and delta is - (r - sum[i])/(sum[i+1] - sum[i]).") + :definition :method + :c-return :double) diff --git a/init/gsl-objects.lisp b/init/gsl-objects.lisp index 8e382595..3c18759c 100644 --- a/init/gsl-objects.lisp +++ b/init/gsl-objects.lisp @@ -1,6 +1,6 @@ ;; Definition of GSL objects and ways to use them. ;; Liam Healy, Sun Dec 3 2006 - 10:21 -;; Time-stamp: <2008-12-23 19:30:28EST gsl-objects.lisp> +;; Time-stamp: <2008-12-25 12:03:18EST gsl-objects.lisp> ;; $Id$ (in-package :gsl) @@ -11,8 +11,14 @@ :documentation "A pointer to the GSL representation of the object."))) (defmacro defmobject - (class prefix allocation-args description docstring - &optional initialize-suffix initialize-args arglists-function) + (class prefix allocation-args description + &optional docstring initialize-suffix initialize-args arglists-function + inputs) + "Define the class, initialize-instance and reinitialize-instance methods, + and the make-* function for the GSL object." + ;; If prefix is a list, the first is the actual prefix, and the + ;; second is the name of the allocateor. I'm looking at you, + ;; discrete-random. Grrr. (let* ((settingp (make-symbol "SETTINGP")) (arglists (when arglists-function @@ -21,7 +27,8 @@ (maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl)) (cl-alloc-args (variables-used-in-c-arguments allocation-args)) (cl-initialize-args - (variables-used-in-c-arguments initialize-args))) + (variables-used-in-c-arguments initialize-args)) + (realprefix (if (listp prefix) (first prefix) prefix))) `(progn (defclass ,class (mobject) () @@ -29,7 +36,7 @@ ,(format nil "The GSL representation of the ~a." description))) (defmfun initialize-instance ((object ,class) &key ,@cl-alloc-args) - ,(format nil "~a_alloc" prefix) + ,(if (listp prefix) (second prefix) (format nil "~a_alloc" prefix)) ,allocation-args :definition :method :qualifier :after @@ -38,18 +45,23 @@ (tg:finalize object (lambda () - (foreign-funcall ,(format nil "~a_free" prefix) :pointer ,mptr :void)))) + (foreign-funcall ,(format nil "~a_free" realprefix) + :pointer ,mptr :void)))) :return (object) :export nil :index ,maker) ,@(when initialize-suffix - `((defmfun reinitialize-instance ((object ,class) &key ,@cl-initialize-args) - ,(format nil "~a_~a" prefix initialize-suffix) + `((defmfun reinitialize-instance + ,(if initialize-args + `((object ,class) &key ,@cl-initialize-args) + `((object ,class))) + ,(format nil "~a_~a" realprefix initialize-suffix) (((mpointer object) :pointer) ,@initialize-args) :definition :method :qualifier :after :return (object) + ,@(when inputs `(:inputs ,inputs)) :export nil :index (reinitialize-instance ,class)))) @@ -58,12 +70,12 @@ ,(if arglists (first arglists) `(,@cl-alloc-args - ,@(when initialize-suffix + ,@(when initialize-args (append (list '&optional (list (first cl-initialize-args) nil settingp)) (rest cl-initialize-args))))) - ,(format nil "Create the GSL object representing a ~a (class ~a).~&~a" + ,(format nil "Create the GSL object representing a ~a (class ~a).~@[~&~a~]" description class docstring) (let ((object (make-instance @@ -71,13 +83,16 @@ ,@(if arglists (second arglists) (symbol-keyword-symbol cl-alloc-args))))) + ;; There is an initialization step ,@(when initialize-suffix - `((when ,settingp - (reinitialize-instance - object - ,@(if arglists - (third arglists) - (symbol-keyword-symbol cl-initialize-args)))))) + (if initialize-args ; with arguments + `((when ,settingp + (reinitialize-instance + object + ,@(if arglists + (third arglists) + (symbol-keyword-symbol cl-initialize-args))))) + '((reinitialize-instance object)))) ; without arguments object))))) (defun symbol-keyword-symbol (symbol) diff --git a/init/interface.lisp b/init/interface.lisp index ef5a103d..f4407f0c 100644 --- a/init/interface.lisp +++ b/init/interface.lisp @@ -1,6 +1,6 @@ ;; Macros to interface GSL functions, including definitions necessary for defmfun. ;; Liam Healy -;; Time-stamp: <2008-11-16 18:57:24EST interface.lisp> +;; Time-stamp: <2008-12-25 14:11:57EST interface.lisp> ;; $Id$ (in-package :gsl) @@ -126,10 +126,11 @@ ;;;; Variables in library ;;;;**************************************************************************** -(defmacro defmpar (cl-symbol gsl-symbol documentation) +(defmacro defmpar + (cl-symbol gsl-symbol documentation &optional (c-type :pointer) (read-only t)) "Define a library variable pointer." `(progn - (cffi:defcvar (,gsl-symbol ,cl-symbol :read-only t) :pointer + (cffi:defcvar (,gsl-symbol ,cl-symbol :read-only ,read-only) ,c-type ,documentation) (map-name ',cl-symbol ,gsl-symbol) (export ',cl-symbol))) diff --git a/interpolation/lookup.lisp b/interpolation/lookup.lisp index 992e32e0..fb70cacf 100644 --- a/interpolation/lookup.lisp +++ b/interpolation/lookup.lisp @@ -1,6 +1,6 @@ ;; Index lookup and acceleration ;; Liam Healy, Sun Nov 4 2007 - 18:09 -;; Time-stamp: <2008-12-21 22:20:36EST lookup.lisp> +;; Time-stamp: <2008-12-25 11:11:51EST lookup.lisp> ;; $Id$ (in-package :gsl) @@ -11,7 +11,7 @@ (defmobject acceleration "gsl_interp_accel" () "acceleration for interpolation" ; FDL - "Allocate an accelerator object, which is a + "Make an accelerator object, which is a kind of iterator for interpolation lookups. It tracks the state of lookups, thus allowing for application of various acceleration strategies.") diff --git a/monte-carlo.lisp b/monte-carlo.lisp index a55bc644..6684a919 100644 --- a/monte-carlo.lisp +++ b/monte-carlo.lisp @@ -1,6 +1,6 @@ ;; Monte Carlo Integration ;; Liam Healy Sat Feb 3 2007 - 17:42 -;; Time-stamp: <2008-11-30 23:04:24EST monte-carlo.lisp> +;; Time-stamp: <2008-12-25 11:42:39EST monte-carlo.lisp> ;; $Id$ (in-package :gsl) @@ -13,6 +13,16 @@ (dim sizet) (x :pointer)) +#| +(defmobject monte-carlo-plain + "gsl_monte_plain" + ((dim sizet)) + "plain Monte Carlo integration" ; FDL + "Make and initialize a workspace for Monte Carlo integration in dim dimensions." + "init" + nil) +|# + (defgo-s (monte-carlo-plain dim) monte-carlo-plain-alloc monte-carlo-plain-free) (defmfun monte-carlo-plain-alloc (dim) @@ -97,6 +107,18 @@ (hits-l :pointer) (hits-r :pointer)) +#| +(defmobject monte-carlo-miser + "gsl_monte_miser" + ((dim sizet)) + "miser Monte Carlo integration" ; FDL + "Make and initialize a workspace for Monte Carlo integration in + dim dimensions. The workspace is used to maintain + the state of the integration." + "init" + nil) +|# + (defgo-s (monte-carlo-miser dim) monte-carlo-miser-alloc monte-carlo-miser-free) (defmfun monte-carlo-miser-alloc (dim) @@ -201,6 +223,18 @@ (calls-per-box :uint) (ostream :pointer)) +#| +(defmobject monte-carlo-vegas + "gsl_monte_vegas" + ((dim sizet)) + "vegas Monte Carlo integration" ; FDL + "Make and initialize a workspace for Monte Carlo integration in + dim dimensions. The workspace is used to maintain + the state of the integration. Returns a pointer to vegas-state." + "init" + nil) +|# + (defgo-s (monte-carlo-vegas dim) monte-carlo-vegas-alloc monte-carlo-vegas-free) (defmfun monte-carlo-vegas-alloc (dim) diff --git a/numerical-integration.lisp b/numerical-integration.lisp index 4c043e08..82ef57ab 100644 --- a/numerical-integration.lisp +++ b/numerical-integration.lisp @@ -1,6 +1,6 @@ ;; Numerical integration ;; Liam Healy, Wed Jul 5 2006 - 23:14 -;; Time-stamp: <2008-12-07 18:51:13EST numerical-integration.lisp> +;; Time-stamp: <2008-12-25 11:22:57EST numerical-integration.lisp> ;; $Id$ ;;; To do: QAWS, QAWO, QAWF, more tests @@ -36,6 +36,14 @@ ;;;; QAG adaptive Gauss-Kronrod integration ;;;;**************************************************************************** +#| +(defmobject integration-workspace + "gsl_integration_workspace" ((size sizet)) + "integration workspace" ; FDL + "Make a workspace sufficient to hold n double + precision intervals, their integration results and error estimates.") +|# + (defgo-s (integration-workspace size) integration-workspace-alloc integration-workspace-free) diff --git a/polynomial.lisp b/polynomial.lisp index 84c7635f..48fc1078 100644 --- a/polynomial.lisp +++ b/polynomial.lisp @@ -1,6 +1,6 @@ ;; Polynomials ;; Liam Healy, Tue Mar 21 2006 - 18:33 -;; Time-stamp: <2008-12-06 16:08:23EST polynomial.lisp> +;; Time-stamp: <2008-12-25 10:01:23EST polynomial.lisp> ;; $Id$ (in-package :gsl) @@ -120,6 +120,13 @@ ;;;; General Polynomial Equations ;;;;**************************************************************************** +#| +(defmobject polynomial-complex-workspace "gsl_poly_complex_workspace" + ((n sizet)) + "complex workspace for polynomials") +|# + + (defgo-s (complex-workspace n) allocate-complex-workspace free-complex-workspace) diff --git a/random/discrete.lisp b/random/discrete.lisp index d9b6dc94..57b0de07 100644 --- a/random/discrete.lisp +++ b/random/discrete.lisp @@ -1,10 +1,23 @@ ;; Discrete random variables ;; Liam Healy, Sat Nov 11 2006 - 21:51 -;; Time-stamp: <2008-11-30 23:13:24EST discrete.lisp> +;; Time-stamp: <2008-12-25 11:55:10EST discrete.lisp> ;; $Id$ (in-package :gsl) +#| +(defmobject discrete-random + ("gsl_ran_discrete" "gsl_ran_discrete_preproc") + (((dim0 probabilities) sizet) ((c-pointer probabilities) :pointer)) + "lookup table for the discrete random number generator" ; FDL + "Make a structure that contains the lookup + table for the discrete random number generator. The array probabilities contains + the probabilities of the discrete events; these array elements must all be + positive, but they needn't add up to one (so you can think of them more + generally as ``weights'')---the preprocessor will normalize appropriately. + This return value is used as an argument to #'discrete.") +|# + (defgo-s (discrete-random probabilities) discrete-preprocess discrete-free) (defmfun discrete-preprocess (probabilities) diff --git a/random/generators.lisp b/random/generators.lisp index fea2aa8b..004d3344 100644 --- a/random/generators.lisp +++ b/random/generators.lisp @@ -1,98 +1,39 @@ ;; Generators of random numbers. ;; Liam Healy, Sat Jul 15 2006 - 14:43 -;; Time-stamp: <2008-10-25 13:34:33EDT generators.lisp> +;; Time-stamp: <2008-12-25 14:28:48EST generators.lisp> ;; $Id$ (in-package :gsl) -;;; Would it be useful to have a make-data like macro? - -(export '(make-random-number-generator)) - -(defgeneric generator (object) - (:method ((object t)) - (if (cffi:pointerp object) - object - (call-next-method))) - (:documentation "The foreign pointer to the GSL generator function.")) - -(defclass gsl-random () - ((type :initarg :type :reader rng-type) - (generator :initarg :generator :accessor generator))) - -(defclass random-number-generator (gsl-random) - () - (:documentation "A generator of random numbers.")) - -(defmethod print-object ((object gsl-random) stream) - (print-unreadable-object (object stream :type t :identity t) - (format stream "~a" (when (generator object) (rng-name object))))) - -(defun make-random-number-generator - (&optional (type *default-type*) (generator t)) - "Make a random number generator; by default it is allocated on creation." - (let ((instance - (make-instance - 'random-number-generator - :type type - :generator generator))) - (if (eq generator t) (alloc instance) instance))) - -(defgo-s (random-number-generator type value) - make-random-number-generator free rng-set 1) - ;;;;**************************************************************************** -;;;; Initialization +;;;; Object ;;;;**************************************************************************** -;;; These should have defgenerics -(defmfun alloc ((generator random-number-generator)) - "gsl_rng_alloc" (((rng-type generator) :pointer)) - :definition :method - :export t - :c-return (ptr :pointer) - :return ((progn (setf (generator generator) ptr) generator)) - :documentation ; FDL - "Instatiate a random number generator of specified type. - For example, create an instance of the Tausworthe - generator: (rng-alloc *taus*). - The generator is automatically initialized with the default seed, - *default-seed*. This is zero by default but can be changed - either directly or by using the environment variable GSL_RNG_SEED.") - -(defmfun free ((generator random-number-generator)) - "gsl_rng_free" (((generator generator) :pointer)) - :definition :method - :export t - :c-return :void - :after ((setf (generator generator) nil)) - :documentation ; FDL - "Free all the memory associated with the generator.") +(defmobject random-number-generator + "gsl_rng" + ((rng-type :pointer)) + "random number generator" ; FDL + "Make and optionally initialize (or `seed') the random number + generator of the specified type. If the generator is seeded with + the same value of s on two different runs, the same stream of + random numbers will be generated by successive calls. If different + values of s are supplied, then the generated streams of random + numbers should be completely different. If the seed s is zero then + the standard seed from the original implementation is used instead. + For example, the original Fortran source code for the *ranlux* + generator used a seed of 314159265, and so choosing s equal to zero + reproduces this when using *ranlux*." + "set" + ((value :ulong))) ;;;;**************************************************************************** ;;;; Seed ;;;;**************************************************************************** -(cffi:defcvar ("gsl_rng_default_seed" *default-seed*) :ulong) -(setf (documentation '*default-seed* 'variable) - "The default seed for random number generators.") -(map-name '*default-seed* "gsl_rng_cmrg") -(export '*default-seed*) - -(defmfun rng-set (rng-instance value) - "gsl_rng_set" (((generator rng-instance) :pointer) (value :ulong)) - :c-return :void - :documentation ; FDL - "Initialize (or `seeds') the random number generator. If - the generator is seeded with the same value of s on two different - runs, the same stream of random numbers will be generated by successive - calls to the routines below. If different values of s are - supplied, then the generated streams of random numbers should be - completely different. If the seed s is zero then the standard seed - from the original implementation is used instead. For example, the - original Fortran source code for the *ranlux* generator used a seed - of 314159265, and so choosing s equal to zero reproduces this when - using *ranlux*.") +(defmpar *default-seed* + "gsl_rng_default_seed" + "The default seed for random number generators." + :ulong nil) ;;;;**************************************************************************** ;;;; Sampling @@ -222,13 +163,8 @@ making destination into an exact copy of source. The two generators must be of the same type.") -(export 'clone-generator) -(defgeneric clone-generator (instance) - (:documentation ; FDL - "Create a new generator which is an exact copy of the original. - Don't use; use #'make-random-number-generator, #'copy instead.")) - -(defmfun clone-generator ((instance random-number-generator)) +;;; This returns a bare C pointer, which isn't too useful. +(defmfun clone ((instance random-number-generator)) "gsl_rng_clone" (((generator instance) :pointer)) :c-return :pointer :definition :method) diff --git a/random/quasi.lisp b/random/quasi.lisp index 24d829be..0b14b036 100644 --- a/random/quasi.lisp +++ b/random/quasi.lisp @@ -1,61 +1,19 @@ ;; Quasi-random sequences in arbitrary dimensions. ;; Liam Healy, Sun Jul 16 2006 - 15:54 -;; Time-stamp: <2008-12-22 18:55:05EST quasi.lisp> +;; Time-stamp: <2008-12-25 14:28:57EST quasi.lisp> ;; $Id$ (in-package :gsl) -(defclass quasi-random-number-generator (gsl-random) - ((dimension :initarg :dimension :accessor qr-dimension)) - (:documentation "A generator of quasi-random numbers.")) - -(defparameter *default-quasi-random-number-generator* nil) - -(defgo-s (quasi-random-number-generator dimension type) - make-quasi-random-number-generator free nil 2) - -(defun make-quasi-random-number-generator - (dimension - &optional (type *default-quasi-random-number-generator*) - (generator t)) - "Make a random number generator; by default it is allocated on creation." - (let ((instance - (make-instance - 'quasi-random-number-generator - :type type - :dimension dimension - :generator generator))) - (if (eq generator t) (alloc instance) instance))) - -(defmfun alloc ((generator quasi-random-number-generator)) - "gsl_qrng_alloc" - (((rng-type generator) :pointer) ((qr-dimension generator) :uint)) - :definition :method - :c-return (ptr :pointer) - :return ((progn (setf (generator generator) ptr) generator)) - :documentation ; FDL - "Instatiate a random number generator of specified type. - For example, create an instance of the Tausworthe - generator: (rng-alloc *taus*). - The generator is automatically initialized with the default seed, - *default-seed*. This is zero by default but can be changed - either directly or by using the environment variable GSL_RNG_SEED.") - -(defmfun free ((generator quasi-random-number-generator)) - "gsl_qrng_free" (((generator generator) :pointer)) - :definition :method - :c-return :void - :after ((setf (generator generator) nil)) - :documentation ; FDL - "Free all the memory associated with the generator.") - -(defmfun initialize (generator) - "gsl_qrng_init" (((generator generator) :pointer)) - :c-return :void - :documentation ; FDL - "Reinitializes the generator q to its starting point. +(defmobject quasi-random-number-generator + "gsl_qrng" + ((rng-type :pointer) (dimension :uint)) + "quasi random number generator" ; FDL + "Make and optionally initialize the generator q to its starting point. Note that quasi-random sequences do not use a seed and always produce - the same set of values.") + the same set of values." + "init" + nil) (defmfun qrng-get (generator return-vector) "gsl_qrng_get" @@ -64,7 +22,7 @@ :return (return-vector) :documentation ; FDL "Store the next point from the sequence generator q - in the array. The space available fopr it must match the + in the array. The space available for it must match the dimension of the generator. The point will lie in the range 0 < x_i < 1 for each x_i.") @@ -98,10 +56,11 @@ pre-existing generator dest, making dest into an exact copy of src. The two generators must be of the same type.") -(defmfun clone-generator ((instance quasi-random-number-generator)) +;;; This returns a bare C pointer, which isn't too useful. +(defmfun clone ((instance quasi-random-number-generator)) "gsl_qrng_clone" (((generator instance) :pointer)) - :c-return :pointer :definition :method + :c-return :pointer :documentation ; FDL "Create a new generator which is an exact copy of the original. Don't use; use #'make-random-number-generator, #'copy instead.") @@ -113,10 +72,6 @@ valid up to 12 dimensions." "gsl_qrng_niederreiter_2") -(eval-when (:load-toplevel :execute) - (setf *default-quasi-random-number-generator* - (make-quasi-random-number-generator 2 *niederreiter2*))) - (def-rng-type *sobol* ;; FDL "This generator uses the Sobol sequence described in Antonov, Saleev, diff --git a/solve-minimize-fit/linear-least-squares.lisp b/solve-minimize-fit/linear-least-squares.lisp index 011b5e6f..03d00076 100644 --- a/solve-minimize-fit/linear-least-squares.lisp +++ b/solve-minimize-fit/linear-least-squares.lisp @@ -1,6 +1,6 @@ ;; Linear least squares, or linear regression ;; Liam Healy <2008-01-21 12:41:46EST linear-least-squares.lisp> -;; Time-stamp: <2008-12-07 19:04:02EST linear-least-squares.lisp> +;; Time-stamp: <2008-12-25 10:35:32EST linear-least-squares.lisp> ;; $Id$ (in-package :gsl) @@ -129,6 +129,14 @@ ;;;; Multiparameter fitting ;;;;**************************************************************************** +#| +(defmobject fit-workspace + "gsl_multifit_linear" + ((number-of-observations sizet) (number-of-parameters sizet)) + "multi-dimensional root solver with function only" + "Make a workspace for a multidimensional linear least-squares fit.") +|# + (defgo-s (fit-workspace number-of-observations number-of-parameters) allocate-fit-workspace free-fit-workspace nil 2) diff --git a/solve-minimize-fit/minimization-multi.lisp b/solve-minimize-fit/minimization-multi.lisp index 174e65c7..3342b3ab 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: <2008-12-07 19:09:05EST minimization-multi.lisp> +;; Time-stamp: <2008-12-25 10:32:16EST minimization-multi.lisp> ;; $Id$ (in-package :gsl) @@ -48,6 +48,39 @@ ;;;; Initialization ;;;;**************************************************************************** +#| +(defmobject multi-dimensional-minimizer-f + "gsl_multimin_fminimizer" + ((type :pointer) (dimension sizet)) + "multi-dimensional minimizer with function only" ; FDL + "Make an instance of a minimizer of the given for an function of the + given dimensions. Optionally initialize the minimizer to minimize + the function starting from the initial point. The size of the + initial trial steps is given in vector step-size. The precise + meaning of this parameter depends on the method used." + "set" + ((function :pointer) ((mpointer initial) :pointer) + ((mpointer step-size) :pointer))) + +(defmobject multi-dimensional-minimizer-fdf + "gsl_multimin_fdfminimizer" + ((type :pointer) (dimension sizet)) + "multi-dimensional minimizer with function and derivative" ; FDL + "Make an instance of a derivative-based minimizer of the given for + an function of the given dimensions. Optionally initialize the + minimizer to minimize the function starting from the initial point. + The size of the first trial step is given by step-size. The + accuracy of the line minimization is specified by tolernace. The + precise meaning of this parameter depends on the method used. + Typically the line minimization is considered successful if the + gradient of the function g is orthogonal to the current search + direction p to a relative accuracy of tolerance, where dot(p,g) < + tol |p| |g|." + "set" + ((function-derivative :pointer) ((mpointer initial) :pointer) + (step-size :double) (tolerance :double))) +|# + ;;; Could have one fewer argument: dimension=(dim0 initial) (defgo-s (mfminimizer type dimension function intial step-size) allocate-mfminimizer free-mfminimizer set-mfminimizer 2) diff --git a/solve-minimize-fit/minimization-one.lisp b/solve-minimize-fit/minimization-one.lisp index 1c482eb1..51848286 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: <2008-11-16 14:25:08EST minimization-one.lisp> +;; Time-stamp: <2008-12-25 10:22:13EST minimization-one.lisp> ;; $Id$ (in-package :gsl) @@ -9,6 +9,19 @@ ;;;; Initialization ;;;;**************************************************************************** +#| +;; The one-dimensional minimizer uses a function (no derivative) only. +(defmobject one-dimensional-minimizer + "gsl_min_fminimizer" + ((type :pointer)) + "one-dimensional minimizer" ; FDL + "Make an instance of a minimizer of the given type. Optionally + set to use the function and the initial search interval [lower, + upper], with a guess for the location of the minimum." + "set" + ((function :pointer) (minimum :double) (lower :double) (upper :double))) +|# + (defgo-s (fminimizer type function minimum lower upper) allocate-fminimizer free-fminimizer set-fminimizer) diff --git a/solve-minimize-fit/roots-multi.lisp b/solve-minimize-fit/roots-multi.lisp index 91bfd98e..e50ed37a 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: <2008-12-07 19:09:04EST roots-multi.lisp> +;;; Time-stamp: <2008-12-25 12:04:09EST roots-multi.lisp> ;;; $Id$ (in-package :gsl) @@ -37,6 +37,42 @@ ;;;; Initialization ;;;;**************************************************************************** +#| +(defmobject multi-dimensional-root-solver-f "gsl_multiroot_fsolver" + ((type :pointer) (dimension sizet)) + "multi-dimensional root solver with function only" ; FDL + "Make an instance of a solver of the type specified for a system of + the specified number of dimensions. Optionally + set or reset an existing solver to use the function and the + initial guess gsl-vector." + "set" + ((function :pointer) ((mpointer initial) :pointer)) + (lambda (set) + `((type &optional function-or-dimension (initial ,set)) + (:type type + :dimension + (if ,set (dim0 initial) function-or-dimension)) + (:function function-or-dimension :initial initial))) + (initial)) + +(defmobject multi-dimensional-root-solver-fdf "gsl_multiroot_fdfsolver" + ((type :pointer) (dimension sizet)) + "multi-dimensional root solver with function and derivative" ; FDL + "Make an instance of a derivative solver of the type specified for + a system of the specified number of dimensions. Optionally + set or reset an existing solver to use the function and derivative + (fdf) and the initial guess." + "set" + ((function-derivative :pointer) ((mpointer initial) :pointer)) + (lambda (set) + `((type &optional function-or-dimension (initial ,set)) + (:type type + :dimension + (if ,set (dim0 initial) function-or-dimension)) + (:function function-or-dimension :initial initial))) + (initial)) +|# + (defgo mfsolver (type function-derivative initial) (list `(allocate-mfsolver ,type (dim0 ,initial)) diff --git a/solve-minimize-fit/roots-one.lisp b/solve-minimize-fit/roots-one.lisp index 0aca6806..fa639faa 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: <2008-12-23 22:39:13EST roots-one.lisp> +;; Time-stamp: <2008-12-25 10:14:02EST roots-one.lisp> ;; $Id$ (in-package :gsl) @@ -45,14 +45,14 @@ ;;;;**************************************************************************** #| -(defmobject fsolver "gsl_root_fsolver" +(defmobject one-dimensional-root-solver-f "gsl_root_fsolver" ((type :pointer)) "one-dimensional root solver with function only" ; FDL "" "set" ((function :pointer) (lower :double) (upper :double))) -(defmobject fdfsolver "gsl_root_fdfsolver" +(defmobject one-dimensional-root-solver-fdf "gsl_root_fdfsolver" ((type :pointer)) "one-dimensional root solver with function and derivative" ; FDL "" -- GitLab