diff --git a/basis-splines.lisp b/basis-splines.lisp index b76a5153e48d992834f86b278fc673fb7faece80..3772ccc2f6c9c0ad69d041f651417a6eee0915e8 100644 --- a/basis-splines.lisp +++ b/basis-splines.lisp @@ -1,6 +1,6 @@ ;; Basis splines. ;; Liam Healy 2008-02-18 14:43:20EST basis-splines.lisp -;; Time-stamp: <2008-12-26 10:25:46EST basis-splines.lisp> +;; Time-stamp: <2008-12-26 12:51:25EST basis-splines.lisp> ;; $Id$ (in-package :gsl) @@ -8,7 +8,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Should be subclass of interpolation? -#| (defmobject basis-spline "gsl_bspline" ((order sizet) (number-of-breakpoints sizet)) "basis spline" ; FDL @@ -16,31 +15,6 @@ breakpoints is given by number-of-breakpoints. This leads to n = nbreak + k - 2 basis functions where k = order. Cubic B-splines are specified by k = 4. The size of the workspace is O(5k + nbreak).") -|# - -;;; Initializing the B-splines solver -(defgo-s (basis-spline order number-of-breakpoints) allocate-basis-spline free-basis-spline nil 2) - -(defmfun allocate-basis-spline (order number-of-breakpoints) - "gsl_bspline_alloc" - ((order sizet) (number-of-breakpoints sizet)) - :c-return :pointer - :export nil - :index (letm basis-spline) - :documentation ; FDL - "Allocate a workspace for computing B-splines. The number of - breakpoints is given by number-of-breakpoints. This leads to n = - nbreak + k - 2 basis functions where k = order. Cubic B-splines are - specified by k = 4. The size of the workspace is O(5k + nbreak)." ) - -(defmfun free-basis-spline (bspline) - "gsl_bspline_free" - ((bspline :pointer)) - :c-return :void - :export nil - :index (letm basis-spline) - :documentation ; FDL - "Free the memory associated with the workspace of the bspline.") ;;; Constructing the knots vector (defmfun knots (breakpoints workspace) @@ -101,17 +75,13 @@ ;;; Examples and unit test -#| - -|# - (defun bspline-example (&optional (ncoeffs 8)) - (letm ((order 4) ; cubic + (let* ((order 4) ; cubic (ndata 200) (nbreak (+ ncoeffs 2 (- order))) (bw (make-basis-spline order nbreak)) - (mw (fit-workspace ndata ncoeffs)) - (rng (random-number-generator *mt19937* 0)) + (mw (make-fit-workspace ndata ncoeffs)) + (rng (make-random-number-generator *mt19937* 0)) (B (make-marray 'double-float :dimensions ncoeffs)) (c (make-marray 'double-float :dimensions ncoeffs)) (cov (make-marray 'double-float :dimensions (list ncoeffs ncoeffs))) @@ -141,11 +111,11 @@ (weighted-linear-mfit Xmatrix w y c cov mw) ;; Return the smoothed curve (loop for xi from 0.0d0 to 15.0d0 by 0.1d0 - with yval and yerr - do - (evaluate-bspline xi B bw) - (multiple-value-setq (yval yerr) - (multi-linear-estimate B c cov)) - collect yval into yvals - collect yerr into yerrs - finally (return (values yvals yerrs))))) + with yval and yerr + do + (evaluate-bspline xi B bw) + (multiple-value-setq (yval yerr) + (multi-linear-estimate B c cov)) + collect yval into yvals + collect yerr into yerrs + finally (return (values yvals yerrs))))) diff --git a/chebyshev.lisp b/chebyshev.lisp index c6410fb324794797b161ecbd59dbf254c71be405..446795c45802aacc3603e6d20dcbf151ad480064 100644 --- a/chebyshev.lisp +++ b/chebyshev.lisp @@ -1,56 +1,20 @@ ;; Chebyshev Approximations ;; Liam Healy Sat Nov 17 2007 - 20:36 -;; Time-stamp: <2008-12-23 21:46:27EST chebyshev.lisp> +;; Time-stamp: <2008-12-26 11:21:25EST chebyshev.lisp> ;; $Id$ (in-package :gsl) -#| +;;;;**************************************************************************** +;;;; Creation and calculation of Chebyshev series +;;;;**************************************************************************** + (defmobject chebyshev "gsl_cheb" ((order sizet)) "Chebyshev series" ; FDL "Make a Chebyshev series of specified order." "init" ((function :pointer) (lower-limit :double) (upper-limit :double))) -|# - -;;;;**************************************************************************** -;;;; Creation and calculation of Chebyshev series -;;;;**************************************************************************** - -(defgo-s (chebyshev order function lower-limit upper-limit) - allocate-chebyshev free-chebyshev initialize-chebyshev) - -(defmfun allocate-chebyshev (order) - "gsl_cheb_alloc" - ((order sizet)) - :c-return :pointer - :export nil - :index (letm chebyshev) - :documentation ; FDL - "Allocate a Chebyshev series of specified order - and return a pointer to it.") - -(defmfun free-chebyshev (chebyshev) - "gsl_cheb_free" - ((chebyshev :pointer)) - :c-return :void - :export nil - :index (letm chebyshev) - :documentation ; FDL - "Free a previously allocated Chebyshev series.") - -(defmfun initialize-chebyshev (chebyshev function lower-limit upper-limit) - "gsl_cheb_init" - ((chebyshev :pointer) (function :pointer) - (lower-limit :double) (upper-limit :double)) - :export nil - :index (letm chebyshev) - :documentation ; FDL - "Compute the Chebyshev approximation for the function over the range - (lower-limit, upper-limit) to the previously specified order. The - computation of the Chebyshev approximation is an O(n^2) - process, and requires n function evaluations.") ;;;;**************************************************************************** ;;;; Chebyshev series evaluation @@ -111,7 +75,7 @@ (defun chebyshev-table-example () (let ((steps 100)) - (letm ((cheb (chebyshev 40 chebyshev-step 0.0d0 1.0d0))) + (let ((cheb (make-chebyshev 40 chebyshev-step 0.0d0 1.0d0))) (dotimes (i steps) (let ((x (coerce (/ i steps) 'double-float))) (format t "~&~a ~a ~a ~a" @@ -122,9 +86,9 @@ (defun chebyshev-point-example (x) (check-type x double-float) - (letm ((cheb (chebyshev 40 chebyshev-step 0.0d0 1.0d0)) - (deriv (chebyshev 40)) - (integ (chebyshev 40))) + (let ((cheb (make-chebyshev 40 chebyshev-step 0.0d0 1.0d0)) + (deriv (make-chebyshev 40)) + (integ (make-chebyshev 40))) (derivative-chebyshev deriv cheb) (integral-chebyshev integ cheb) (list diff --git a/data/array-tests.lisp b/data/array-tests.lisp index 52a32e33511957da21dfc40b7e8c4f953c96ffce..63e25139ad46a3dc3e52cdaf06d6f0369b95aa52 100644 --- a/data/array-tests.lisp +++ b/data/array-tests.lisp @@ -1,6 +1,6 @@ ;; Tests of array functions ;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp -;; Time-stamp: <2008-11-30 22:51:15EST array-tests.lisp> +;; Time-stamp: <2008-12-26 12:23:58EST array-tests.lisp> ;; $Id: $ ;;; Generate each file with #'write-test-to-file, e.g. @@ -17,7 +17,7 @@ (generate-all-array-tests vector-set-all-m+ :no-complex - (letm ((v1 (array-default 3 t)) + (let ((v1 (array-default 3 t)) (v2 (array-default 3))) (set-all v1 (scalar-default)) (cl-array (m+ v1 v2)))) @@ -31,40 +31,40 @@ (generate-all-array-tests vector-set-zero t - (letm ((v1 (array-default 3))) + (let ((v1 (array-default 3))) (set-zero v1) (cl-array v1))) (generate-all-array-tests matrix-set-zero t - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (set-zero m1) (cl-array m1))) (generate-all-array-tests vector-copy t - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3 t))) (copy v2 v1) (cl-array v2))) (generate-all-array-tests matrix-copy t - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3) t))) (copy m2 m1) (cl-array m2))) (generate-all-array-tests vector-swap t - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3))) (swap v2 v1) (list (cl-array v1) (cl-array v2)))) (generate-all-array-tests matrix-swap t - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3)))) (swap m2 m1) (list (cl-array m1) (cl-array m2)))) @@ -74,59 +74,59 @@ ;;;;**************************************************************************** (generate-all-array-tests vector-m+ :no-complex - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3))) (cl-array (m+ v1 v2)))) (generate-all-array-tests matrix-m+ :no-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3)))) (cl-array (m+ m1 m2)))) (generate-all-array-tests vector-m- :no-complex - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3))) (cl-array (m- v1 v2)))) (generate-all-array-tests matrix-m- :no-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3)))) (cl-array (m- m1 m2)))) (generate-all-array-tests vector-mult :no-complex - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3))) (cl-array (m* v1 v2)))) (generate-all-array-tests matrix-mult :no-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3)))) (cl-array (m* m1 m2)))) (generate-all-array-tests vector-div :no-complex - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3))) (cl-array (m/ v1 v2)))) (generate-all-array-tests matrix-div :no-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3)))) (cl-array (m/ m1 m2)))) (generate-all-array-tests vector-mult-scalar :no-complex - (letm ((v1 (array-default 3))) + (let ((v1 (array-default 3))) (cl-array (m*c v1 1.39d0)))) (generate-all-array-tests matrix-mult-scalar :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (m*c m1 1.39d0)))) (generate-all-array-tests vector-add-scalar :no-complex - (letm ((v1 (array-default 3))) + (let ((v1 (array-default 3))) (cl-array (m+c v1 18.19d0)))) (generate-all-array-tests matrix-add-scalar :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (m+c m1 18.19d0)))) ;;;;**************************************************************************** @@ -134,53 +134,53 @@ ;;;;**************************************************************************** (generate-all-array-tests vector-max :no-complex - (letm ((v1 (array-default 3))) + (let ((v1 (array-default 3))) (mmax v1))) (generate-all-array-tests matrix-max :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (mmax m1))) #| Temporarily commented out twos-complement answer for SIGNED-BYTE-8 and SIGNED-BYTE-16 (generate-all-array-tests vector-min :no-complex - (letm ((v1 (array-default 3))) + (let ((v1 (array-default 3))) (mmin v1))) (generate-all-array-tests matrix-min :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (mmin m1))) |# (generate-all-array-tests vector-minmax :no-complex - (letm ((v1 (array-default 3))) + (let ((v1 (array-default 3))) (minmax v1))) (generate-all-array-tests matrix-minmax :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (minmax m1))) (generate-all-array-tests vector-min-index :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (min-index v1))) (generate-all-array-tests matrix-min-index :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (min-index m1))) (generate-all-array-tests vector-max-index :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (max-index v1))) (generate-all-array-tests matrix-max-index :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (max-index m1))) (generate-all-array-tests vector-minmax-index :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (minmax-index v1))) (generate-all-array-tests matrix-minmax-index :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (minmax-index m1))) ;;; No test for mzerop yet. @@ -190,17 +190,17 @@ ;;;;**************************************************************************** (generate-all-array-tests set-basis t - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (set-basis v1 2) (cl-array v1))) (generate-all-array-tests swap-elements t - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (swap-elements v1 2 5) (cl-array v1))) (generate-all-array-tests vector-reverse t - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (cl-array (vector-reverse v1)))) ;;;;**************************************************************************** @@ -208,48 +208,48 @@ ;;;;**************************************************************************** (generate-all-array-tests set-identity t - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (set-identity m1)))) (generate-all-array-tests row t - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (row (array-default 3 t))) (cl-array (row row m1 1)))) (generate-all-array-tests setf-row t - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (row (array-default 3))) (setf (row m1 2) row) (cl-array m1))) (generate-all-array-tests column t - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (col (array-default 3 t))) (cl-array (column col m1 1)))) (generate-all-array-tests setf-column t - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (col (array-default 3))) (setf (column m1 2) col) (cl-array m1))) (generate-all-array-tests swap-rows t - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (swap-rows m1 0 1)))) (generate-all-array-tests swap-columns t - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (swap-columns m1 1 2)))) (generate-all-array-tests swap-row-column t - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (swap-row-column m1 0 2)))) (generate-all-array-tests matrix-transpose t - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (matrix-transpose m1)))) (generate-all-array-tests matrix-transpose-copy t - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3) t))) (cl-array (matrix-transpose-copy m2 m1)))) diff --git a/data/marray.lisp b/data/marray.lisp index 84adfbeb1207e63f09cbf52fee0b235de2cb2090..0b64e479bb3e46b1d29d1adc6ab0114cc9cc7270 100644 --- a/data/marray.lisp +++ b/data/marray.lisp @@ -1,6 +1,6 @@ ;; A "marray" is an array in both GSL and CL ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2008-12-26 10:25:50EST marray.lisp> +;; Time-stamp: <2008-12-26 12:49:10EST marray.lisp> ;; $Id$ (in-package :gsl) @@ -283,6 +283,6 @@ (unless (eq blockptr array-struct) (cffi:foreign-free blockptr)) (cffi:foreign-free array-struct))) - (setf (mpointer object) array-struct)))))) + (setf (slot-value object 'mpointer) array-struct)))))) ;;; For #-native, do the whole thing using _alloc, _free functions. diff --git a/eigensystems.lisp b/eigensystems.lisp index f6e3693637a23e71338e4e70b758f73017123923..a0b81a2e3508b33abb4c7a3a6cc332adc1dbeef7 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-12-26 10:28:19EST eigensystems.lisp> +;; Time-stamp: <2008-12-26 11:14:06EST eigensystems.lisp> ;; $Id$ (in-package :gsl) @@ -9,112 +9,33 @@ ;;;; 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) - "gsl_eigen_symm_alloc" ((n sizet)) - :c-return :pointer - :export nil - :index '(letm eigen-symm) - :documentation ; FDL - "Allocate a workspace for computing eigenvalues of - n-by-n real symmetric matrices. The size of the workspace - is O(2n).") - -(defmfun eigen-symm-free (w) - "gsl_eigen_symm_free" ((w :pointer)) - :c-return :void - :export nil - :index '(letm eigen-symm) - :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) - "gsl_eigen_symmv_alloc" ((n sizet)) - :c-return :pointer - :export nil - :index '(letm eigen-symmv) - :documentation ; FDL - "Allocate a workspace for computing eigenvalues and - eigenvectors of n-by-n real symmetric matrices. The size of - the workspace is O(4n).") - -(defmfun eigen-symmv-free (w) - "gsl_eigen_symmv_free" ((w :pointer)) - :index '(letm eigen-symmv) - :c-return :void - :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) - "gsl_eigen_herm_alloc" ((n sizet)) - :documentation ; FDL - "Allocate a workspace for computing eigenvalues of - n-by-n complex hermitian matrices. The size of the workspace - is O(3n)." - :c-return :pointer) - -(defmfun eigen-herm-free (w) - "gsl_eigen_herm_free" ((w :pointer)) - :c-return :void - :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) - "gsl_eigen_hermv_alloc" ((n sizet)) - :documentation ; FDL - "Allocate a workspace for computing eigenvalues and - eigenvectors of n-by-n complex hermitian matrices. The size of - the workspace is O(5n)." - :c-return :pointer) - -(defmfun eigen-hermv-free (w) - "gsl_eigen_hermv_free" ((w :pointer)) - :c-return :void - :documentation ; FDL - "Free the memory associated with the workspace w.") ;;;;**************************************************************************** ;;;; Eigenvalues and eigenvectors @@ -194,9 +115,9 @@ ;;;;**************************************************************************** (defun eigenvalue-eigenvectors-example () - (letm ((evecs (make-marray 'double-float :dimensions '(3 3))) + (let ((evecs (make-marray 'double-float :dimensions '(3 3))) (evals (make-marray 'double-float :dimensions 3)) - (ws (eigen-symmv 3)) + (ws (make-eigen-symmv 3)) (mat #m((20.0d0 -10.0d0 0.0d0) (-10.0d0 30.0d0 0.0d0) (0.0d0 0.0d0 40.0d0)))) diff --git a/hankel.lisp b/hankel.lisp index b9efaaaac80f10249d395952c43971c9328183c2..db08744fbcbccdb6bb5b18ccf36099f92f3d8704 100644 --- a/hankel.lisp +++ b/hankel.lisp @@ -1,11 +1,12 @@ ;; Discrete Hankel Transforms. ;; Liam Healy, Sat Dec 8 2007 - 16:50 -;; Time-stamp: <2008-12-21 21:38:24EST hankel.lisp> +;; Time-stamp: <2008-12-26 11:56:49EST hankel.lisp> ;; $Id$ (in-package :gsl) -#| +;;; Everything compiles, but not tested -- need example. + ;;; Create the Hankel transform object and essential methods/functions. (defmobject hankel "gsl_dht" ((size sizet)) @@ -14,52 +15,7 @@ optionally initialize the transform for the given values of nu and x." "new" ((nu :double) (xmax :double))) -|# - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;;; Everything compiles, but not tested -- need example. - -(defgo-s (hankel size nu xmax) allocate-hankel free-hankel init-hankel) - -(defmfun allocate-hankel (size) - "gsl_dht_alloc" - ((size sizet)) - :c-return :pointer - :export nil - :index (letm hankel) - :documentation ; FDL - "Allocate a Discrete Hankel transform object of given size.") - -(defmfun init-hankel (hankel nu xmax) - "gsl_dht_new" - ((hankel :pointer) (nu :double) (xmax :double)) - :export nil - :index (letm hankel) - :documentation ; FDL - "Initialize the transform for the given values of nu and x.") - -;; This seems redundant; does it effectively combine allocate-hankel -;; and init-hankel? In this case we don't really need, and shouldn't -;; export it. -(defmfun new-hankel (size nu xmax) - "gsl_dht_new" - ((size sizet) (nu :double) (xmax :double)) - :c-return :pointer - :documentation ; FDL - "Allocate a Discrete Hankel transform object of size - size and initializes it for the given values of nu and - xmax.") - -(defmfun free-hankel (hankel) - "gsl_dht_free" - ((hankel :pointer)) - :c-return :void - :export nil - :index (letm hankel) - :documentation ; FDL - "Free the Hankel object.") +;;; We don't use gsl_dht_init because we use gsl_dht_new? (defmfun apply-hankel (hankel array-in array-out) "gsl_dht_apply" diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp index 1ebb90f16e65f316431d39153b251cb4a8a123cc..2bb5e86d36f2f2e6672fd95f9163dc51eeb03186 100644 --- a/histogram/histogram.lisp +++ b/histogram/histogram.lisp @@ -1,6 +1,6 @@ ;; The histogram structure ;; Liam Healy, Mon Jan 1 2007 - 11:32 -;; Time-stamp: <2008-12-25 22:49:25EST histogram.lisp> +;; Time-stamp: <2008-12-26 12:31:18EST histogram.lisp> ;; $Id$ (in-package :gsl) @@ -32,7 +32,7 @@ (export 'set-ranges-uniform) (defgeneric set-ranges-uniform - (histogram minimum maximum &optional minimum2 maximum2 ) + (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 @@ -46,7 +46,8 @@ ;;; 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) +(defmfun set-ranges-uniform + ((histogram histogram) minimum maximum &optional minimum2 maximum2) "gsl_histogram_set_ranges_uniform" (((mpointer histogram) :pointer) (minimum :double) (maximum :double)) :definition :method @@ -55,7 +56,8 @@ ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. (defmfun set-ranges-uniform - ((histogram histogram2d) x-minimum x-maximum &optional y-minimum y-maximum) + ((histogram histogram2d) x-minimum x-maximum + &optional (y-minimum 0.0d0) (y-maximum 100.0d0)) "gsl_histogram2d_set_ranges_uniform" (((mpointer histogram) :pointer) (x-minimum :double) (x-maximum :double) diff --git a/histogram/operations.lisp b/histogram/operations.lisp index 79914e8558654d9a81f2e6d944d0f861daeeff96..3578b69ac1ee576295bee61b07a915e005f677bb 100644 --- a/histogram/operations.lisp +++ b/histogram/operations.lisp @@ -1,40 +1,33 @@ ;; Histogram operations ;; Liam Healy, Mon Jan 1 2007 - 16:47 -;; Time-stamp: <2008-08-31 10:05:41EDT operations.lisp> +;; Time-stamp: <2008-12-26 14:47:49EST operations.lisp> ;; $Id$ (in-package :gsl) -(defmfun equal-bins-p-1 (histogram1 histogram2) +(export 'equal-bins-p) +(defgeneric equal-bins-p (histogram1 histogram2) + (:documentation ;; FDL + "Are all of the individual bin ranges of the two histograms are identical?")) + +(defmfun equal-bins-p ((histogram1 histogram) (histogram2 histogram)) "gsl_histogram_equal_bins_p" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :c-return :true-false - :export nil - :index equal-bins-p - :documentation ; FDL - "Are all of the individual bin ranges of the two histograms are identical?") + :definition :method + :c-return :true-false) -(defmfun equal-bins-p-2 (histogram1 histogram2) +(defmfun equal-bins-p ((histogram1 histogram2d) (histogram2 histogram2d)) "gsl_histogram2d_equal_bins_p" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :c-return :true-false - :export nil - :index equal-bins-p - :documentation ; FDL - "Are all of the individual bin ranges of the two histograms are identical?") - -(export 'equal-bins-p) -(defun equal-bins-p (histogram1 histogram2) - "Are all of the individual bin ranges of the two histograms are identical?" - (histo-1d2d histogram1 equal-bins-p (histogram2))) + :definition :method + :c-return :true-false) ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m+-1 (histogram1 histogram2) +(defmfun m+ ((histogram1 histogram) (histogram2 histogram)) "gsl_histogram_add" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m+ + :definition :method :documentation ; FDL "Add the contents of the bins in histogram2 to the corresponding bins of histogram1 i.e. h'_1(i) = @@ -43,32 +36,22 @@ ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m+-2 (histogram1 histogram2) +(defmfun m+ ((histogram1 histogram2d) (histogram2 histogram2d)) "gsl_histogram2d_add" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m+ + :definition :method :documentation ; FDL "Add the contents of the bins in histogram2 to the corresponding bins of histogram1 i.e. h'_1(i) = h_1(i) + h_2(i). The two histograms must have identical bin ranges.") -(defmethod m+ ((histogram1 histogram) (histogram2 histogram)) - ;; FDL - "Add the contents of the bins in histogram2 to the - corresponding bins of histogram1 i.e. h'_1(i) = - h_1(i) + h_2(i). The two histograms must have identical bin - ranges." - (histo-1d2d histogram1 m+ (histogram2))) - ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m--1 (histogram1 histogram2) +(defmfun m- ((histogram1 histogram) (histogram2 histogram)) "gsl_histogram_sub" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m- + :definition :method :documentation ; FDL "Subtract the contents of the bins in histogram2 from the corresponding bins of histogram1 i.e. h'_1(i) = h_1(i) - @@ -76,30 +59,21 @@ ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m--2 (histogram1 histogram2) +(defmfun m- ((histogram1 histogram2d) (histogram2 histogram2d)) "gsl_histogram2d_sub" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m- + :definition :method :documentation ; FDL "Subtract the contents of the bins in histogram2 from the corresponding bins of histogram1 i.e. h'_1(i) = h_1(i) - h_2(i). The two histograms must have identical bin ranges.") -(defmethod m- ((histogram1 histogram) (histogram2 histogram)) - ;; FDL - "Subtract the contents of the bins in histogram2 from the - corresponding bins of histogram1 i.e. h'_1(i) = h_1(i) - - h_2(i). The two histograms must have identical bin ranges." - (histo-1d2d histogram1 gsl- (histogram2))) - ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m*-1 (histogram1 histogram2) +(defmfun m* ((histogram1 histogram) (histogram2 histogram)) "gsl_histogram_mul" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m* + :definition :method :documentation ; FDL "Multiply the contents of the bins of histogram1 by the contents of the corresponding bins in histogram2 @@ -108,32 +82,22 @@ ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m*-2 (histogram1 histogram2) +(defmfun m* ((histogram1 histogram2d) (histogram2 histogram2d)) "gsl_histogram2d_mul" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m* + :definition :method :documentation ; FDL "Multiply the contents of the bins of histogram1 by the contents of the corresponding bins in histogram2 i.e. h'_1(i) = h_1(i) * h_2(i). The two histograms must have identical bin ranges.") -(defmethod m* ((histogram1 histogram) (histogram2 histogram)) - ;; FDL - "Multiply the contents of the bins of histogram1 by the - contents of the corresponding bins in histogram2 - i.e. h'_1(i) = h_1(i) * h_2(i). The two histograms - must have identical bin ranges." - (histo-1d2d histogram1 m* (histogram2))) - ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m/-1 (histogram1 histogram2) +(defmfun m/ ((histogram1 histogram) (histogram2 histogram)) "gsl_histogram_div" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m/ + :definition :method :documentation ; FDL "Divide the contents of the bins of histogram1 by the contents of the corresponding bins in histogram2 @@ -142,75 +106,52 @@ ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun m/-2 (histogram1 histogram2) +(defmfun m/ ((histogram1 histogram2d) (histogram2 histogram2d)) "gsl_histogram2d_div" (((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer)) - :export nil - :index m/ + :definition :method :documentation ; FDL "Divide the contents of the bins of histogram1 by the contents of the corresponding bins in histogram2 i.e. h'_1(i) = h_1(i) / h_2(i). The two histograms must have identical bin ranges.") -(defmethod m/ ((histogram1 histogram) (histogram2 histogram)) - ;; FDL - "Divide the contents of the bins of histogram1 by the - contents of the corresponding bins in histogram2 - i.e. h'_1(i) = h_1(i) / h_2(i). The two histograms - must have identical bin ranges." - (histo-1d2d histogram1 m/ (histogram2))) - ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun scale-1 (histogram scale) +(defmfun scale ((histogram histogram) scale) "gsl_histogram_scale" (((mpointer histogram) :pointer) (scale :double)) - :export nil - :index scale + :definition :method :documentation ; FDL "Multiply the contents of the bins of histogram by the constant scale, i.e. h'_1(i) = h_1(i) * scale.") ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun scale-2 (histogram scale) +(defmfun scale ((histogram histogram2d) scale) "gsl_histogram2d_scale" (((mpointer histogram) :pointer) (scale :double)) - :export nil - :index scale + :definition :method :documentation ; FDL "Multiply the contents of the bins of histogram by the constant scale, i.e. h'_1(i) = h_1(i) * scale.") -(defmethod scale (scale (histogram histogram)) - ;; FDL - "Multiply the contents of the bins of histogram by the - constant scale, i.e. h'_1(i) = h_1(i) * scale." - (histo-1d2d histogram scale (scale))) +(export 'shift) +(defgeneric shift (histogram offset) + (:documentation ;; FDL + "Shift the contents of the bins of histogram h by the + constant offset, i.e. h'_1(i) = h_1(i) + offset.")) ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun shift-1 (histogram offset) +(defmfun shift ((histogram histogram) offset) "gsl_histogram_shift" (((mpointer histogram) :pointer) (offset :double)) - :export nil - :index shift - :documentation ; FDL - "Shift the contents of the bins of histogram h by the - constant offset, i.e. h'_1(i) = h_1(i) + offset.") + :definition :method) ;;; GSL documentation does not state what the return value for the ;;; C function means; assumed to be error code. -(defmfun shift-2 (histogram offset) +(defmfun shift ((histogram histogram2d) offset) "gsl_histogram2d_shift" (((mpointer histogram) :pointer) (offset :double)) - :export nil - :index shift - :documentation ; FDL - "Shift the contents of the bins of histogram h by the - constant offset, i.e. h'_1(i) = h_1(i) + offset.") - -(export 'shift) -(defun shift (histogram offset) - (histo-1d2d histogram shift (offset))) + :definition :method) diff --git a/histogram/probability-distribution.lisp b/histogram/probability-distribution.lisp index ebd4701b73d71c520e8fcce48f46fedeb36165c6..17e8273f3951c96c3ce7e9f9a41d446cebad3160 100644 --- a/histogram/probability-distribution.lisp +++ b/histogram/probability-distribution.lisp @@ -1,6 +1,6 @@ ;; Histogram probability distribution. ;; Liam Healy, Mon Jan 1 2007 - 17:51 -;; Time-stamp: <2008-12-25 13:06:55EST probability-distribution.lisp> +;; Time-stamp: <2008-12-26 14:47:01EST probability-distribution.lisp> ;; $Id$ (in-package :gsl) @@ -47,7 +47,7 @@ :definition :method :c-return :double) -(defmfun sample-2 (pdf value) +(defmfun sample ((pdf histogram2d-pdf) value) "gsl_histogram2d_pdf_sample" (((mpointer pdf) :pointer) (value :double)) :definition :method diff --git a/histogram/statistics.lisp b/histogram/statistics.lisp index f18654cebe3ceb722dc5062aff2510799863f6fa..2ab7d47871bcbfe936fb72c9acddbdb062555383 100644 --- a/histogram/statistics.lisp +++ b/histogram/statistics.lisp @@ -1,118 +1,98 @@ ;; Statistics of histograms. ;; Liam Healy, Mon Jan 1 2007 - 16:13 -;; Time-stamp: <2008-08-23 19:42:07EDT statistics.lisp> +;; Time-stamp: <2008-12-26 14:46:23EST statistics.lisp> ;; $Id$ (in-package :gsl) -(defmfun mmax-1 (histogram) +(defmfun mmax ((histogram histogram)) "gsl_histogram_max_val" (((mpointer histogram) :pointer)) + :definition :method :c-return :double - :export nil - :index mmax :documentation ; FDL "The maximum value contained in the histogram bins.") -(defmfun mmax-2 (histogram) +(defmfun mmax ((histogram histogram2d)) "gsl_histogram2d_max_val" (((mpointer histogram) :pointer)) + :definition :method :c-return :double - :export nil - :index mmax :documentation ; FDL "The maximum value contained in the histogram bins.") -(defmethod mmax ((histogram histogram)) - "The maximum value contained in the histogram bins." - (histo-1d2d histogram mmax)) - -(defmfun mmin-1 (histogram) +(defmfun mmin ((histogram histogram)) "gsl_histogram_min_val" (((mpointer histogram) :pointer)) + :definition :method :c-return :double - :export nil - :index mmin :documentation ; FDL "The minimum value contained in the histogram bins.") -(defmfun mmin-2 (histogram) +(defmfun mmin ((histogram histogram2d)) "gsl_histogram2d_min_val" (((mpointer histogram) :pointer)) + :definition :method :c-return :double - :export nil - :index mmin :documentation ; FDL "The minimum value contained in the histogram bins.") -(defmethod mmin ((histogram histogram)) ; FDL - "The minimum value contained in the histogram bins." - (histo-1d2d histogram mmin)) - -(defmfun max-index-1 (histogram) +(defmfun max-index ((histogram histogram)) "gsl_histogram_max_bin" (((mpointer histogram) :pointer)) + :definition :method :c-return sizet - :export nil - :index max-index :documentation ; FDL "The index of the bin containing the maximum value. In the case where several bins contain the same maximum value the smallest index is returned.") -(defmfun max-index-2 (histogram) +(defmfun max-index ((histogram histogram2d)) "gsl_histogram2d_max_bin" (((mpointer histogram) :pointer) (xindex sizet) (yindex sizet)) + :definition :method :c-return :void - :export nil - :index max-index :documentation ; FDL "The indices of the bin containing the maximum value. In the case where several bins contain the same maximum value the first bin found is returned.") -(defmethod max-index ((histogram histogram)) - (histo-1d2d histogram max-index)) - -(defmfun min-index-1 (histogram) +(defmfun min-index ((histogram histogram)) "gsl_histogram_min_bin" (((mpointer histogram) :pointer)) + :definition :method :c-return sizet - :export nil - :index min-index :documentation ; FDL "The index of the bin containing the minimum value. In the case where several bins contain the same minimum value the smallest index is returned.") -(defmfun min-index-2 (histogram) +(defmfun min-index ((histogram histogram2d)) "gsl_histogram2d_min_bin" (((mpointer histogram) :pointer) (xindex sizet) (yindex sizet)) + :definition :method :c-return :void - :export nil - :index min-index :documentation ; FDL "The indices of the bin containing the minimum value. In the case where several bins contain the same minimum value the first bin found is returned.") -(defmethod min-index ((histogram histogram)) - (histo-1d2d histogram min-index)) - -(defmfun mean-1 (histogram) +(defmfun mean ((histogram histogram)) "gsl_histogram_mean" (((mpointer histogram) :pointer)) + :definition :method :c-return :double - :export nil - :index mean :documentation ; FDL "The mean of the histogrammed variable, where the histogram is regarded as a probability distribution. Negative bin values are ignored for the purposes of this calculation. The resolution of the result is limited by the bin width.") +(defmethod mean ((histogram histogram2d)) + (values (mean-2x histogram) (mean-2y histogram))) + (defmfun mean-2x (histogram) "gsl_histogram2d_xmean" (((mpointer histogram) :pointer)) @@ -135,27 +115,21 @@ is regarded as a probability distribution. Negative bin values are ignored for the purposes of this calculation.") -(defmethod mean ((histogram histogram)) ; FDL - "The mean of the histogrammed y variable, where the histogram - is regarded as a probability distribution. Negative bin values - are ignored for the purposes of this calculation. For 2d - histograms, the means are returned as multiple values." - (flet ((mean-2 (histogram) - (values (mean-2x histogram) (mean-2y histogram)))) - (histo-1d2d histogram mean ))) +(export 'sigma) +(defgeneric sigma (histogram) + (:documentation ;; FDL + "The standard deviation of the histogrammed variable, where the + histogram is regarded as a probability distribution. Negative + bin values are ignored for the purposes of this + calculation. The resolution of the result is limited by the + bin width. For 2d histograms, the sigmas are returned as + multiple values.")) -(defmfun sigma-1 (histogram) +(defmfun sigma ((histogram histogram)) "gsl_histogram_sigma" (((mpointer histogram) :pointer)) :c-return :double - :export nil - :index sigma - :documentation ; FDL - "The standard deviation of the histogrammed variable, where the - histogram is regarded as a probability distribution. Negative - bin values are ignored for the purposes of this - calculation. The resolution of the result is limited by the bin - width.") + :definition :method) (defmfun sigma-2x (histogram) "gsl_histogram2d_xsigma" @@ -171,17 +145,8 @@ :export nil :index sigma) -(export 'sigma) -(defun sigma (histogram) - "The standard deviation of the histogrammed variable, where the - histogram is regarded as a probability distribution. Negative - bin values are ignored for the purposes of this - calculation. The resolution of the result is limited by the - bin width. For 2d histograms, the sigmas are returned as - multiple values." ; FDL - (flet ((sigma-2 (histogram) - (values (sigma-2x histogram) (sigma-2y histogram)))) - (histo-1d2d histogram sigma))) +(defmethod sigma ((histogram histogram2d)) + (values (sigma-2x histogram) (sigma-2y histogram))) (defmfun histogram-covariance (histogram-2d) "gsl_histogram2d_cov" @@ -193,29 +158,20 @@ distribution. Negative bin values are ignored for the purposes of this calculation.") -(defmfun sum-1 (histogram) +(export 'sum) +(defgeneric sum (histogram) + (:documentation ;; FDL + "The sum of all bin values. Negative bin values are included in + the sum.")) + +(defmfun sum ((histogram histogram)) "gsl_histogram_sum" (((mpointer histogram) :pointer)) :c-return :double - :export nil - :index sum - :documentation ; FDL - "The sum of all bin values. Negative bin values are included in - the sum.") + :definition :method) -(defmfun sum-2 (histogram) +(defmfun sum ((histogram histogram2d)) "gsl_histogram2d_sum" (((mpointer histogram) :pointer)) - :c-return :double - :export nil - :index sum - :documentation ; FDL - "The sum of all bin values. Negative bin values are included in - the sum.") - -(export 'sum) -(defun sum (histogram) - ;; FDL - "The sum of all bin values. Negative bin values are included in - the sum." - (histo-1d2d histogram sum)) + :definition :method + :c-return :double) diff --git a/histogram/updating-accessing.lisp b/histogram/updating-accessing.lisp index 7e5405d42339b6cd06bc9b24c024cb9cf94da535..14be3f90bd919696e7627e19308f6f03d9bfab63 100644 --- a/histogram/updating-accessing.lisp +++ b/histogram/updating-accessing.lisp @@ -1,6 +1,6 @@ ;; Updating and accessing histogram elements. ;; Liam Healy, Mon Jan 1 2007 - 14:43 -;; Time-stamp: <2008-11-16 13:26:01EST updating-accessing.lisp> +;; Time-stamp: <2008-12-26 11:58:11EST updating-accessing.lisp> ;; $Id$ (in-package :gsl) @@ -93,7 +93,7 @@ signalled.") #| - (letm ((histo (histogram 10))) ; should be a gsl-warning here, how to check? + (let ((histo (make-histogram 10))) ; should be a gsl-warning here, how to check? (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo -2.0d0)) |# @@ -102,40 +102,40 @@ (save-test histogram ;; The first one gives a warning while compiling in SBCL, ;; should only give a warning while runnin. - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo -2.0d0)) - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) (maref histo 1)) - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) (maref histo 2)) - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) (maref histo 6)) - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) (maref histo 16)) - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) (values (min-range histo) (max-range histo))) - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) (bins histo)) - (letm ((histo (histogram 10))) + (let ((histo (make-histogram 10))) (set-ranges-uniform histo 0.0d0 10.0d0) (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) diff --git a/init/mobject.lisp b/init/mobject.lisp index af59937f598f0655c46f5f7e93b6001ebba7309b..d9fb9ee88fe1750dbdfb75ce0d94439ef85e598d 100644 --- a/init/mobject.lisp +++ b/init/mobject.lisp @@ -1,22 +1,27 @@ ;; Definition of GSL objects and ways to use them. ;; Liam Healy, Sun Dec 3 2006 - 10:21 -;; Time-stamp: <2008-12-25 23:01:24EST gsl-objects.lisp> +;; Time-stamp: <2008-12-26 13:21:44EST mobject.lisp> ;; $Id$ +;;; GSL objects are represented in GSLL as and instance of a 'mobject. +;;; The macro demobject takes care of defining the appropriate +;;; subclass, the methods #'initialize-instance, +;;; #'reinitialize-instance, and #'allocate, and the function +;;; #'make-<class-name>, which is what the user calls to make the +;;; object. + (in-package :gsl) -#| (defclass mobject () ((mpointer :initarg :mpointer :reader mpointer :documentation "A pointer to the GSL representation of the object."))) - (defmacro defmobject (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." + "Define the class, the allocate, 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. @@ -56,9 +61,7 @@ ,@(when initialize-suffix `((defmfun reinitialize-instance - ,(if initialize-args - `((object ,class) &key ,@cl-initialize-args) - `((object ,class))) + ((object ,class) &key ,@cl-initialize-args) ,(format nil "~a_~a" realprefix initialize-suffix) (((mpointer object) :pointer) ,@initialize-args) :definition :method @@ -108,7 +111,6 @@ ;;; (make-basis-spline (bspline-order bspline) (number-of-breakpoints bspline)) ;;; Then initialize by making a vector from (breakpoint i bspline) ;;; and calling knots. -|# (defgeneric allocate (object &key &allow-other-keys) (:documentation @@ -121,131 +123,7 @@ (:method :around ((object mobject)) (make-instance (class-of object) :mpointer (call-next-method)))) -;;;;;;;;;;;;;;;;;;;;;;;; OLD ;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -;;; There are numerous "GSL objects" which need to by manually -;;; memory-managed. The macro letm takes care of this. -;;; A method #'letm-expansion which eql specializes on the object name -;;; in the second argument is responsible for doing the expansion. -;;; -;;; Many GSL objects simply need to be allocated, optionally set, and -;;; then freed after the work has been done. To cover those cases, -;;; the macro #'defgo (and simpler macro #'defgo-s) is defined. The -;;; default #'letm-expansion assumes that the object has been defined -;;; with defgo or defgo-s. Their names are saved in -;;; *letm-expanded-object*. -;;; -;;; Each object has a defun named after it, with an arglist -;;; (and perhaps docstring) appropriate for when that form -;;; is a binding to a letm. This function shouldn't be called; -;;; it is defined and exported for the benefit of arglist -;;; displayers like slime. - - -(export 'letm) -(defmacro letm (bindings &body body) - (first (letm-expand bindings body))) - -(defun letm-expand (bindings body) - (if (null bindings) - body - (let ((binding (first bindings))) - (if (and (listp binding) (listp (second binding))) - (destructuring-bind (symbol (object &rest arguments)) - binding - `(,(letm-expansion - symbol - object - arguments - (letm-expand (rest bindings) body)))) - ;; binding value is an atom or not present - `((let (,binding) - ,@(letm-expand (rest bindings) body))))))) - -(defvar *not-for-users* nil) -(defparameter *letm-expanded-object* nil) - -(defun not-for-users (form) - (unless *not-for-users* - (error "The form ~a should be placed in the binding of a letm." - form))) - -(defmacro arglist-only (symbol docstring &rest arglist) - "Define objects to be used with letm bindings, but - make the function itself signal an error." - `(eval-when (:compile-toplevel :load-toplevel :execute) - (pushnew ',symbol *letm-expanded-object*) - (export ',symbol) - (defun ,symbol (,@arglist) ,docstring - (declare (ignorable ,@arglist)) - (not-for-users (list ',symbol ,@arglist))))) - -(defgeneric letm-expansion (symbol type args body) - ;; The method that expands a defgo-created object. - (:method (symbol type args body) - (if (member type *letm-expanded-object*) - (let ((*not-for-users* t)) - (destructuring-bind (allocator freer &optional setter assign) - (if type (apply type args) (list nil nil)) - `(let* (,@(when assign (list (funcall assign))) - (,symbol ,allocator)) - (unwind-protect - (progn - ,@(when setter (list (funcall setter symbol))) - ,@body) - (,freer ,symbol))))) - ;; Not a GSL object; create a regular let form - `(let ((,symbol (,type ,@args))) - ,@body)))) - -;;; General definition for object creation -(defmacro defgo (symbol arglist &body body) - "Define a GSL object to be bound in a letm. - The body should return a list of two to four values. - The first is the allocation form, the second is - the freeing function name, the third is - form to set or initialize the object, - and the last is a function of no arguments - that gives a form to be bound in a let prior - to binding the object. The symbol will be exported - even though users should not call the function, so that - it will show up in arglist prompters." - `(eval-when (:compile-toplevel :load-toplevel :execute) - (pushnew ',symbol *letm-expanded-object*) - (export ',symbol) - (defun ,symbol ,arglist - (not-for-users ',(cons symbol arglist)) - ,@body))) - -;;; Specific, simple and common types of object creation -(defmacro defgo-s (form allocate free &optional set (num-alloc-args 1)) - "Make an object usable in letm with the arglist is the allocate - and set arglists appended." - (let ((symb (gensym "SASF"))) - `(defgo ,(first form) - (,@(subseq (rest form) 0 num-alloc-args) - &optional - ,@(when set `((,(nth num-alloc-args (rest form)) - nil - settingp))) - ,@(when set (subseq (rest form) (1+ num-alloc-args)))) - (list - `(,',allocate ,,@(subseq (rest form) 0 num-alloc-args)) - ',free - ,@(when set - `((when settingp - (lambda (,symb) - `(,',set ,,symb ,,@(subseq (rest form) num-alloc-args)))))))))) - ;;; Pointer type (defconstant +foreign-pointer-class+ (class-name (class-of (cffi:null-pointer))) "The class in which foreign pointers fall. This will be assumed to be a GSL vector or matrix.") - -;;; Generic allocation and free used for histograms and random -(export '(alloc free)) -(defgeneric alloc (object) - (:documentation "Allocate the GSL storage.")) -(defgeneric free (object) - (:documentation "Free the GSL storage.")) diff --git a/interpolation/interpolation.lisp b/interpolation/interpolation.lisp index a656172107b9c2a6816117624eb967008499146d..76f32ea7e6b7e65eec208cc170b9b1453954c3d7 100644 --- a/interpolation/interpolation.lisp +++ b/interpolation/interpolation.lisp @@ -1,11 +1,12 @@ ;; Interpolation allocation, initialization, and freeing. ;; Liam Healy, Sun Nov 4 2007 - 17:24 -;; Time-stamp: <2008-12-23 21:42:31EST interpolation.lisp> +;; Time-stamp: <2008-12-26 11:20:11EST interpolation.lisp> ;; $Id$ (in-package :gsl) -#| +;;; A spline is an interpolation that also stores the arrays xa and ya, +;;; so they need not be supplied on each call. (defmobject interpolation "gsl_interp" ((type :pointer) (size sizet)) "interpolation" ; FDL @@ -21,52 +22,7 @@ `((type &optional xa-or-size (ya nil ,set)) (:type type :size (if ,set (dim0 ya) xa-or-size)) (:xa xa-or-size :ya ya)))) -|# - -;;; A spline is an interpolation that also stores the arrays xa and ya, -;;; so they need not be supplied on each call. - -(defgo interpolation (type xa-or-size &optional ya) - (list - `(allocate-interpolation ,type ,(if ya `(dim0 ,ya) xa-or-size)) - 'free-spline - (when ya - (lambda (symb) - `(initialize-interpolation ,symb ,xa-or-size ,ya))))) - -;;; Interpolation -(defmfun allocate-interpolation (type size) - "gsl_interp_alloc" - ((type :pointer) (size sizet)) - :c-return :pointer - :export nil - :index (letm interpolation) - :documentation ; FDL - "Allocate an interpolation object of type for size data-points, - and return the pointer to it.") - -(defmfun initialize-interpolation (interpolation xa ya) - "gsl_interp_init" - ((interpolation :pointer) - ((c-pointer xa) :pointer) ((c-pointer ya) :pointer) ((dim0 xa) sizet)) - :inputs (xa ya) - :documentation ; FDL - "Initialize the interpolation object interp for the - data (xa,ya) where xa and ya are vectors. The interpolation object does not save - the data arrays xa and ya and only stores the static state - computed from the data. The xa data array is always assumed to be - strictly ordered; the behavior for other arrangements is not defined.") -(defmfun free-interpolation (interpolation) - "gsl_interp_free" - ((interpolation :pointer)) - :c-return :void - :export nil - :index (letm interpolation) - :documentation ; FDL - "Frees the interpolation object interp.") - -#| (defmobject spline "gsl_spline" ((type :pointer) (size sizet)) "spline" ; FDL @@ -77,40 +33,3 @@ `((type &optional xa-or-size (ya nil ,set)) (:type type :size (if ,set (dim0 ya) xa-or-size)) (:xa xa-or-size :ya ya)))) -|# - -(defgo spline (type xa-or-size &optional ya) - (list - `(allocate-spline ,type ,(if ya `(dim0 ,ya) xa-or-size)) - 'free-spline - (when ya - (lambda (symb) - `(initialize-spline ,symb ,xa-or-size ,ya))))) - -;;; Spline -(defmfun allocate-spline (type size) - "gsl_spline_alloc" - ((type :pointer) (size sizet)) - :c-return :pointer - :documentation ; FDL - "Allocate an interpolation object of type for size data-points, - and return the pointer to it.") - -(defmfun initialize-spline (interpolation xa ya) - "gsl_spline_init" - ((interpolation :pointer) - ((c-pointer xa) :pointer) ((c-pointer ya) :pointer) ((dim0 xa) sizet)) - :inputs (xa ya) - :documentation ; FDL - "Initialize the interpolation object interp for the - data (xa,ya) where xa and ya are c-pointers. The spline object saves - the data arrays xa and ya computed from the data. - The xa data array is always assumed to be - strictly ordered; the behavior for other arrangements is not defined.") - -(defmfun free-spline (interpolation) - "gsl_spline_free" - ((interpolation :pointer)) - :c-return :void - :documentation ; FDL - "Frees the spline object.") diff --git a/interpolation/lookup.lisp b/interpolation/lookup.lisp index fb70cacf1891b0f3c546b35850fd2151b2b18f1b..d286494c0448c1c4125db5bd427e3b97ec501a83 100644 --- a/interpolation/lookup.lisp +++ b/interpolation/lookup.lisp @@ -1,13 +1,10 @@ ;; Index lookup and acceleration ;; Liam Healy, Sun Nov 4 2007 - 18:09 -;; Time-stamp: <2008-12-25 11:11:51EST lookup.lisp> +;; Time-stamp: <2008-12-26 11:18:49EST lookup.lisp> ;; $Id$ (in-package :gsl) -(defgo-s (acceleration) allocate-acceleration free-acceleration nil 0) - -#| (defmobject acceleration "gsl_interp_accel" () "acceleration for interpolation" ; FDL @@ -15,7 +12,6 @@ kind of iterator for interpolation lookups. It tracks the state of lookups, thus allowing for application of various acceleration strategies.") -|# (defmfun interpolation-search (x-array x low-index high-index) "gsl_interp_bsearch" @@ -26,18 +22,6 @@ that x-array[i] <= x < x-array[i+1]. The index is searched for in the range [low-index, high-index].") -(defmfun allocate-acceleration () - "gsl_interp_accel_alloc" - () - :c-return :pointer - :export nil - :index (letm acceleration) - :documentation ; FDL - "Allocate 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.") - (defmfun accelerated-interpolation-search (x-array x acceleration) "gsl_interp_accel_find" ((acceleration :pointer) (x-array :pointer) (x :double)) @@ -46,12 +30,3 @@ "Search the data array x-array of size, using the given acceleration. This is how lookups are performed during evaluation of an interpolation. The function returns an index i such that x_array[i] <= x < x_array[i+1]}.") - -(defmfun free-acceleration (acceleration) - "gsl_interp_accel_free" - ((acceleration :pointer)) - :export nil - :index (letm acceleration) - :c-return :void - :documentation ; FDL - "Frees the accelerator object.") diff --git a/interpolation/spline-example.lisp b/interpolation/spline-example.lisp index a995d40b4f431fc053bc21d7be44f0aa224ab146..108dca41f189ccda7d70fe6ea26e754d451cfb37 100644 --- a/interpolation/spline-example.lisp +++ b/interpolation/spline-example.lisp @@ -1,6 +1,6 @@ ;; Example spline ;; Liam Healy, Sat Nov 10 2007 - 21:18 -;; Time-stamp: <2008-12-26 10:29:01EST spline-example.lisp> +;; Time-stamp: <2008-12-26 12:53:23EST spline-example.lisp> ;; $Id$ (in-package :gsl) @@ -19,9 +19,9 @@ "The first example in Sec. 26.7 of the GSL manual." (multiple-value-bind (xarr yarr) (spline-example-arrays) - (letm ((acc (acceleration)) + (let* ((acc (make-acceleration)) (cxarr (make-marray 'double-float :dimensions xarr)) (cyarr (make-marray 'double-float :dimensions yarr)) - (spline (spline *cubic-spline-interpolation* cxarr cyarr))) + (spline (make-spline *cubic-spline-interpolation* cxarr cyarr))) (loop for xi from (aref xarr 0) below (aref xarr 9) by 0.01d0 - collect (list xi (evaluate-spline spline xi acc)))))) + collect (list xi (evaluate-spline spline xi acc)))))) diff --git a/linear-algebra/blas1.lisp b/linear-algebra/blas1.lisp index d14948b669bd6ffe7d03ad3e1154256bf0d15c32..5e20c315ca3ba6a47370f885fce0ffd02c1c4cf2 100644 --- a/linear-algebra/blas1.lisp +++ b/linear-algebra/blas1.lisp @@ -1,6 +1,6 @@ ;; BLAS level 1, Vector operations ;; Liam Healy, Wed Apr 26 2006 - 15:23 -;; Time-stamp: <2008-12-07 18:24:40EST blas1.lisp> +;; Time-stamp: <2008-12-26 12:22:51EST blas1.lisp> ;; $Id$ (in-package :gsl) @@ -188,61 +188,61 @@ ;;;;**************************************************************************** (generate-all-array-tests dot :float-complex - (letm ((v1 (array-default 8)) + (let ((v1 (array-default 8)) (v2 (array-default 8))) (dot v1 v2))) (generate-all-array-tests cdot :complex - (letm ((v1 (array-default 8)) + (let ((v1 (array-default 8)) (v2 (array-default 8))) (cdot v1 v2))) (generate-all-array-tests euclidean-norm :float-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (euclidean-norm v1))) (generate-all-array-tests absolute-sum :float-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (absolute-sum v1))) (generate-all-array-tests index-max :float-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (index-max v1))) (generate-all-array-tests blas-swap :float-complex - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3))) (blas-swap v2 v1) (list (cl-array v1) (cl-array v2)))) (generate-all-array-tests blas-copy :float-complex - (letm ((v1 (array-default 3)) + (let ((v1 (array-default 3)) (v2 (array-default 3 t))) (blas-copy v1 v2) (cl-array v2))) (generate-all-array-tests axpy :float-complex - (letm ((v1 (array-default 8)) + (let ((v1 (array-default 8)) (v2 (array-default 8)) (scalar (scalar-default))) (cl-array (axpy scalar v1 v2)))) (generate-all-array-tests scale :float-complex - (letm ((v1 (array-default 8)) + (let ((v1 (array-default 8)) (scalar (scalar-default))) (cl-array (scale scalar v1)))) (generate-all-array-tests scale :complex - (letm ((v1 (array-default 8)) - (scalar (scalar-default t))) + (let ((v1 (array-default 8)) + (scalar (scalar-default t))) (cl-array (scale scalar v1)))) (generate-all-array-tests givens :float - (letm ((v1 (array-default 8)) - (v2 (array-default 8)) - (angles (array-default 8)) - (sines (array-default 8 t)) - (cosines (array-default 8 t))) + (let ((v1 (array-default 8)) + (v2 (array-default 8)) + (angles (array-default 8)) + (sines (array-default 8 t)) + (cosines (array-default 8 t))) (loop for i below 8 do (setf (maref sines i) (sin (maref angles i))) (setf (maref cosines i) (cos (maref angles i)))) diff --git a/linear-algebra/blas2.lisp b/linear-algebra/blas2.lisp index ed1fe265c03dbf64ed3d7ec6abf081eac4de1f9f..6e16609e111e477eaedfe27c4cb5d5ff51d6bc88 100644 --- a/linear-algebra/blas2.lisp +++ b/linear-algebra/blas2.lisp @@ -1,6 +1,6 @@ ;; BLAS level 2, Matrix-vector operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2008-12-07 18:25:57EST blas2.lisp> +;; Time-stamp: <2008-12-26 12:23:21EST blas2.lisp> ;; $Id$ (in-package :gsl) @@ -298,7 +298,7 @@ ;;;;**************************************************************************** (generate-all-array-tests matrix-product :float-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (answer (array-default 3 t)) (s1 (scalar-default)) @@ -306,19 +306,19 @@ (cl-array (matrix-product m1 v1 answer s1 s2)))) (generate-all-array-tests matrix-product-triangular :float-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (s1 (scalar-default))) (cl-array (matrix-product-triangular m1 v1 s1)))) (generate-all-array-tests inverse-matrix-product :float-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (s1 (scalar-default))) (cl-array (inverse-matrix-product m1 v1 s1)))) (generate-all-array-tests matrix-product-symmetric :float - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (answer (array-default 3 t)) (s1 (scalar-default)) @@ -326,7 +326,7 @@ (cl-array (matrix-product-symmetric m1 v1 answer s1 s2)))) (generate-all-array-tests matrix-product-hermitian :complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (answer (array-default 3 t)) (s1 (scalar-default)) @@ -339,7 +339,7 @@ ;;; [Condition of type EBADLEN] (generate-all-array-tests rank-1-update :float-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) (v2 (array-default 3)) (s1 (scalar-default))) diff --git a/linear-algebra/blas3.lisp b/linear-algebra/blas3.lisp index 242a16f84fdc93bb42cc4406ceaa1e251a088cd9..808c43112980ccbb7dcd2b9079f3643de088630f 100644 --- a/linear-algebra/blas3.lisp +++ b/linear-algebra/blas3.lisp @@ -1,6 +1,6 @@ ;; BLAS level 3, Matrix-matrix operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2008-12-07 18:27:01EST blas3.lisp> +;; Time-stamp: <2008-12-26 12:23:21EST blas3.lisp> ;; $Id$ (in-package :gsl) @@ -138,7 +138,7 @@ ;;;;**************************************************************************** (generate-all-array-tests matrix-product :float-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (answer (array-default '(3 3) t)) (s1 (scalar-default)) @@ -146,19 +146,19 @@ (cl-array (matrix-product m1 m2 answer s1 s2)))) (generate-all-array-tests matrix-product-triangular :float-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (s1 (scalar-default))) (cl-array (matrix-product-triangular m1 m2 s1)))) (generate-all-array-tests inverse-matrix-product :float-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (s1 (scalar-default))) (cl-array (inverse-matrix-product m1 m2 s1)))) (generate-all-array-tests matrix-product-symmetric :float - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (answer (array-default '(3 3) t)) (s1 (scalar-default)) @@ -166,7 +166,7 @@ (cl-array (matrix-product-symmetric m1 m2 answer s1 s2)))) (generate-all-array-tests matrix-product-hermitian :complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(3 3))) (answer (array-default '(3 3) t)) (s1 (scalar-default)) diff --git a/linear-algebra/exponential.lisp b/linear-algebra/exponential.lisp index 1fd1c764dcb789f63a797d8e8f5616c94940d00e..dc05f7ec85afe209cedc035f9718eee40fd792de 100644 --- a/linear-algebra/exponential.lisp +++ b/linear-algebra/exponential.lisp @@ -1,6 +1,6 @@ ;; Exponential of a matrix ;; Liam Healy 2008-08-10 17:25:35EDT exponential.lisp -;; Time-stamp: <2008-12-26 10:25:48EST exponential.lisp> +;; Time-stamp: <2008-12-26 12:25:08EST exponential.lisp> ;; $Id: $ (in-package :gsl) @@ -24,7 +24,7 @@ #| ;;; A matrix of the form [[0, 1], [-1, 0]] ;;; when exponentiated gives [[cos x, sin x], [-sin x, cos x]] -(letm ((mat #m((0.0d0 1.0d0) (-1.0d0 0.0d0))) +(let ((mat #m((0.0d0 1.0d0) (-1.0d0 0.0d0))) (exp (make-marray 'double-float :dimensions '(2 2)))) (cl-array (matrix-exponential mat exp))) #2A((0.5403023058681384d0 0.841470984807895d0) diff --git a/linear-algebra/lu.lisp b/linear-algebra/lu.lisp index a5e2bf14577b3c8f6d5497cad96a0a3f079296ee..7212514ae1b033ea020665e1e6ab6656e18f44f4 100644 --- a/linear-algebra/lu.lisp +++ b/linear-algebra/lu.lisp @@ -1,6 +1,6 @@ ;; LU decomposition ;; Liam Healy, Thu Apr 27 2006 - 12:42 -;; Time-stamp: <2008-12-26 10:25:47EST lu.lisp> +;; Time-stamp: <2008-12-26 12:55:48EST lu.lisp> ;; $Id$ (in-package :gsl) @@ -133,7 +133,7 @@ (export 'invert-matrix) (defun invert-matrix (mat) "Invert the matrix." - (letm ((mmat mat) + (let* ((mmat mat) ; BROKEN, requires copy of mat (dim (array-dimension mat 0)) (per (make-permutation dim)) (inv (make-marray 'double-float :dimensions (list dim dim)))) diff --git a/monte-carlo.lisp b/monte-carlo.lisp index 9762bd1b2781693840a3bb87e61523c3eccd6bef..eb4e911af804ad17db936b345803d6546948645e 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-12-26 10:28:19EST monte-carlo.lisp> +;; Time-stamp: <2008-12-26 11:34:16EST monte-carlo.lisp> ;; $Id$ (in-package :gsl) @@ -9,11 +9,6 @@ ;;;; PLAIN Monte Carlo ;;;;**************************************************************************** -(cffi:defcstruct plain-state - (dim sizet) - (x :pointer)) - -#| (defmobject monte-carlo-plain "gsl_monte_plain" ((dim sizet)) @@ -21,57 +16,10 @@ "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) - "gsl_monte_plain_alloc" - ((dim sizet)) - :c-return :pointer - :export nil - :index (letm monte-carlo-plain) - :documentation ; FDL - "Allocate and initialize a workspace for Monte Carlo - integration in dim dimensions.") - -(defmfun monte-carlo-plain-init (integrator-state) - "gsl_monte_plain_init" - ((integrator-state :pointer)) - :documentation ; FDL - "Initialize a previously allocated integration state. - This allows an existing workspace to be reused for different - integrations.") - -(defmfun monte-carlo-plain-free (integrator-state) - "gsl_monte_plain_free" - ((integrator-state :pointer)) - :c-return :void - :export nil - :index (letm monte-carlo-plain) - :documentation ; FDL - "Frees the memory associated with the integrator.") -(defmfun monte-carlo-integrate-plain - (function lower-limits upper-limits calls generator state) - "gsl_monte_plain_integrate" - ((function :pointer) - ((c-pointer lower-limits) :pointer) ((c-pointer upper-limits) :pointer) - ((dim0 lower-limits) sizet) (calls sizet) - ((generator generator) :pointer) - (state :pointer) - (result :double) (abserr :double)) - :inputs (lower-limits upper-limits) - :documentation ; FDL - "Uses the plain Monte Carlo algorithm to integrate the - function f over the hypercubic region defined by the - lower and upper limits in the arrays 'lower-limits and - 'upper-limits, each a gsl-vector of length dim. - The integration uses a fixed number - of function calls calls, and obtains random sampling points using - the random number generator 'generator. A previously allocated workspace - 'state must be supplied. The result of the integration is returned - with an estimated absolute error.") +(cffi:defcstruct plain-state + (dim sizet) + (x :pointer)) ;;;;**************************************************************************** ;;;; MISER @@ -82,6 +30,16 @@ ;;; integration error by concentrating integration points in the ;;; regions of highest variance. +(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) + (cffi:defcstruct miser-state (min-calls sizet) (min-calls-per-bisection sizet) @@ -107,48 +65,6 @@ (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) - "gsl_monte_miser_alloc" - ((dim sizet)) - :c-return :pointer - :export nil - :index (letm monte-carlo-miser) - :documentation ; FDL - "Allocate 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 miser-state.") - -(defmfun monte-carlo-miser-init (integrator-state) - "gsl_monte_miser_init" - ((integrator-state :pointer)) - :documentation ; FDL - "Initialize a previously allocated integration state. - This allows an existing workspace to be reused for different - integrations.") - -(defmfun monte-carlo-miser-free (integrator-state) - "gsl_monte_miser_free" - ((integrator-state :pointer)) - :c-return :void - :export nil - :index (letm monte-carlo-miser) - :documentation ; FDL - "Frees the memory associated with the integrator.") - (export 'miser-parameter) (defmacro miser-parameter (workspace parameter) ;; FDL @@ -188,6 +104,16 @@ ;;; function |f|, so that the points are concentrated in the regions ;;; that make the largest contribution to the integral. +(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) + (cffi:defcstruct vegas-state ;; grid (dim sizet) @@ -223,48 +149,6 @@ (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) - "gsl_monte_vegas_alloc" - ((dim sizet)) - :c-return :pointer - :export nil - :index (letm monte-carlo-vegas) - :documentation ; FDL - "Allocate 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.") - -(defmfun monte-carlo-vegas-init (integrator-state) - "gsl_monte_vegas_init" - ((integrator-state :pointer)) - :documentation ; FDL - "Initialize a previously allocated integration state. - This allows an existing workspace to be reused for different - integrations.") - -(defmfun monte-carlo-vegas-free (integrator-state) - "gsl_monte_vegas_free" - ((integrator-state :pointer)) - :c-return :void - :export nil - :index (letm monte-carlo-vegas) - :documentation ; FDL - "Frees the memory associated with the integrator.") - (export 'vegas-parameter) (defmacro vegas-parameter (workspace parameter) ;; FDL @@ -327,29 +211,27 @@ (def-mc-function monte-carlo-g 3) (defun random-walk-plain-example (&optional (nsamples 500000)) - (letm ((ws (monte-carlo-plain 3)) + (let ((ws (make-monte-carlo-plain 3)) (lower #m(0.0d0 0.0d0 0.0d0)) (upper (make-marray 'double-float :initial-contents (list pi pi pi))) - (rng (random-number-generator *mt19937* 0))) + (rng (make-random-number-generator *mt19937* 0))) (monte-carlo-integrate-plain monte-carlo-g lower upper nsamples rng ws))) (defun random-walk-miser-example (&optional (nsamples 500000)) - (letm ((ws (monte-carlo-miser 3)) - (lower #m(0.0d0 0.0d0 0.0d0)) - (upper (make-marray 'double-float :initial-contents (list pi pi pi))) - (rng (random-number-generator *mt19937* 0))) + (let ((ws (make-monte-carlo-miser 3)) + (lower #m(0.0d0 0.0d0 0.0d0)) + (upper (make-marray 'double-float :initial-contents (list pi pi pi))) + (rng (make-random-number-generator *mt19937* 0))) (monte-carlo-integrate-miser monte-carlo-g lower upper nsamples rng ws))) (defun random-walk-vegas-example (&optional (nsamples 500000)) - (letm ((ws (monte-carlo-vegas 3)) + (let ((ws (make-monte-carlo-vegas 3)) (lower #m(0.0d0 0.0d0 0.0d0)) (upper (make-marray 'double-float :initial-contents (list pi pi pi))) - (rng (random-number-generator *mt19937* 0))) + (rng (make-random-number-generator *mt19937* 0))) (monte-carlo-integrate-vegas monte-carlo-g lower upper nsamples rng ws))) (save-test monte-carlo (random-walk-plain-example) (random-walk-miser-example) (random-walk-vegas-example)) - - diff --git a/numerical-integration.lisp b/numerical-integration.lisp index 82ef57ab98f3841ba50d108cacebc1a22da4486a..e3732068d980cbcb6423e2165e9819fe65791136 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-25 11:22:57EST numerical-integration.lisp> +;; Time-stamp: <2008-12-26 11:35:14EST numerical-integration.lisp> ;; $Id$ ;;; To do: QAWS, QAWO, QAWF, more tests @@ -36,34 +36,11 @@ ;;;; 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) - -(defmfun integration-workspace-alloc (size) - "gsl_integration_workspace_alloc" ((size sizet)) - :c-return :pointer - :export nil - :index (letm integration-workspace) - :documentation ; FDL - "Allocate a workspace sufficient to hold n double - precision intervals, their integration results and error estimates.") - -(defmfun integration-workspace-free (pointer) - "gsl_integration_workspace_free" - ((pointer :pointer)) - :c-return :void - :export nil - :index (letm integration-workspace) - :documentation ; FDL - "Free the memory associated with the workspace.") (cffi:defcenum integrate-method :gauss15 :gauss21 :gauss31 @@ -237,8 +214,8 @@ (save-test numerical-integration (integration-qng one-sine 0.0d0 pi) - (letm ((ws (integration-workspace 20))) + (let ((ws (make-integration-workspace 20))) (integration-QAG one-sine 0.0d0 pi :gauss15 20 ws)) - (letm ((ws (integration-workspace 20))) + (let ((ws (make-integration-workspace 20))) (integration-QAG one-sine 0.0d0 pi :gauss15 50 ws))) diff --git a/polynomial.lisp b/polynomial.lisp index fbc811f8150eac2a8018c52774b92cb5d91041bb..86e7adf26811200bced462e4d8c6ebb2327b650d 100644 --- a/polynomial.lisp +++ b/polynomial.lisp @@ -1,6 +1,6 @@ ;; Polynomials ;; Liam Healy, Tue Mar 21 2006 - 18:33 -;; Time-stamp: <2008-12-26 10:28:20EST polynomial.lisp> +;; Time-stamp: <2008-12-26 11:10:14EST polynomial.lisp> ;; $Id$ (in-package :gsl) @@ -120,27 +120,9 @@ ;;;; 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) - -(defmfun allocate-complex-workspace (n) - "gsl_poly_complex_workspace_alloc" ((n sizet)) - :c-return :pointer - :export nil - :index (letm complex-workspace)) - -(defmfun free-complex-workspace (ws) - "gsl_poly_complex_workspace_free" ((ws :pointer)) - :c-return :void - :export nil - :index (letm complex-workspace)) (export 'polynomial-solve) (defun polynomial-solve (coefficients) @@ -155,8 +137,8 @@ real and imaginary parts." (let ((len (total-size coefficients))) ;; Should this be making a complex array? - (letm ((answer (make-marray 'double-float :dimensions (* 2 (1- len)))) - (ws (complex-workspace len))) + (let ((answer (make-marray 'double-float :dimensions (* 2 (1- len)))) + (ws (make-polynomial-complex-workspace len))) (values-list (polynomial-solve-ws coefficients ws answer))))) (defmfun polynomial-solve-ws (coefficients workspace answer-pd) diff --git a/random/bernoulli.lisp b/random/bernoulli.lisp index 37eca427f46588f29ffeca694b44d4ab37c3b78e..ddf64042a32a6e77703f6fb73b449a7bca5ff145 100644 --- a/random/bernoulli.lisp +++ b/random/bernoulli.lisp @@ -1,6 +1,6 @@ ;; Bernoulli distribution ;; Liam Healy, Sat Nov 25 2006 - 16:59 -;; Time-stamp: <2008-10-25 12:08:06EDT bernoulli.lisp> +;; Time-stamp: <2008-12-26 11:38:55EST bernoulli.lisp> ;; $Id$ (in-package :gsl) @@ -26,10 +26,8 @@ ;;; Examples and unit test (save-test bernoulli - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (bernoulli rng 0.5d0))) (bernoulli-pdf 0 0.5d0)) -b - diff --git a/random/beta.lisp b/random/beta.lisp index 4122cfb2f50131c6adcc5cb44c3cafb77f54ab7f..86fe5db06664286fd59db2eee9dfe79717a1b3f4 100644 --- a/random/beta.lisp +++ b/random/beta.lisp @@ -1,6 +1,6 @@ ;; Beta distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 12:08:05EDT beta.lisp> +;; Time-stamp: <2008-12-26 11:46:07EST beta.lisp> ;; $Id$ (in-package :gsl) @@ -53,7 +53,7 @@ ;;; Examples and unit test (save-test beta - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (beta-rd rng 1.0d0 2.0d0))) diff --git a/random/binomial.lisp b/random/binomial.lisp index a949266d2a951647b360a03805140f1d18d2083b..baf98d9dfdcf76ea684f8434abf70d7e24edddfb 100644 --- a/random/binomial.lisp +++ b/random/binomial.lisp @@ -1,6 +1,6 @@ ;; Binomial distribution ;; Liam Healy, Sat Nov 25 2006 - 16:00 -;; Time-stamp: <2008-10-25 12:09:46EDT binomial.lisp> +;; Time-stamp: <2008-12-26 11:38:56EST binomial.lisp> ;; $Id$ (in-package :gsl) @@ -41,7 +41,7 @@ ;;; Examples and unit test (save-test binomial - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (binomial rng 0.4d0 12))) diff --git a/random/cauchy.lisp b/random/cauchy.lisp index 4a40c88e4dfdcc5513a465b9e857921b05d51910..589fd4d4a23190b563ef681c74176fe1ddde4022 100644 --- a/random/cauchy.lisp +++ b/random/cauchy.lisp @@ -1,6 +1,6 @@ ;; Cauchy distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 12:13:41EDT cauchy.lisp> +;; Time-stamp: <2008-12-26 11:41:51EST cauchy.lisp> ;; $Id$ (in-package :gsl) @@ -55,7 +55,7 @@ ;;; Examples and unit test (save-test cauchy - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (cauchy rng 10.0d0))) diff --git a/random/chi-squared.lisp b/random/chi-squared.lisp index 4e812a18d734c47c90e517798bd04ba922fb6588..3b3460ab03c401da8eb126dc6351f2b18b07a90d 100644 --- a/random/chi-squared.lisp +++ b/random/chi-squared.lisp @@ -1,6 +1,6 @@ ;; Chi-squared distribution ;; Liam Healy, Sat Oct 7 2006 - 16:13 -;; Time-stamp: <2008-10-25 12:13:41EDT chi-squared.lisp> +;; Time-stamp: <2008-12-26 11:45:06EST chi-squared.lisp> ;; $Id$ (in-package :gsl) @@ -53,7 +53,7 @@ ;;; Examples and unit test (save-test chi-squared - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (chi-squared rng 10.0d0))) diff --git a/random/dirichlet.lisp b/random/dirichlet.lisp index b34ec16862c480ea31970db16878474406f24852..55773d1dab143ef27d7233a8c74799192481ceae 100644 --- a/random/dirichlet.lisp +++ b/random/dirichlet.lisp @@ -1,6 +1,6 @@ ;; Dirichlet distribution ;; Liam Healy, Sun Oct 29 2006 -;; Time-stamp: <2008-12-26 10:28:21EST dirichlet.lisp> +;; Time-stamp: <2008-12-26 11:46:05EST dirichlet.lisp> ;; $Id$ (in-package :gsl) @@ -56,17 +56,17 @@ ;;; Examples and unit test (save-test dirichlet - (letm ((rng (random-number-generator *mt19937* 0)) - (alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) - (theta (make-marray 'double-float :dimensions 4))) - (dirichlet rng alpha theta) - (cl-array theta)) - (letm ((alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) - (theta #m(1.0d0 2.0d0 3.0d0 4.0d0))) - (dirichlet-pdf alpha theta)) - (letm ((alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) - (theta #m(1.0d0 2.0d0 3.0d0 4.0d0))) - (dirichlet-log-pdf alpha theta))) + (let ((rng (make-random-number-generator *mt19937* 0)) + (alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) + (theta (make-marray 'double-float :dimensions 4))) + (dirichlet rng alpha theta) + (cl-array theta)) + (let ((alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) + (theta #m(1.0d0 2.0d0 3.0d0 4.0d0))) + (dirichlet-pdf alpha theta)) + (let ((alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) + (theta #m(1.0d0 2.0d0 3.0d0 4.0d0))) + (dirichlet-log-pdf alpha theta))) diff --git a/random/discrete.lisp b/random/discrete.lisp index 57b0de07165691155bd7bd2bc21d8bf516784cd6..69d869b45b08767832b6a3447639163591038cc7 100644 --- a/random/discrete.lisp +++ b/random/discrete.lisp @@ -1,11 +1,10 @@ ;; Discrete random variables ;; Liam Healy, Sat Nov 11 2006 - 21:51 -;; Time-stamp: <2008-12-25 11:55:10EST discrete.lisp> +;; Time-stamp: <2008-12-26 11:50:24EST discrete.lisp> ;; $Id$ (in-package :gsl) -#| (defmobject discrete-random ("gsl_ran_discrete" "gsl_ran_discrete_preproc") (((dim0 probabilities) sizet) ((c-pointer probabilities) :pointer)) @@ -16,31 +15,6 @@ 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) - "gsl_ran_discrete_preproc" - (((dim0 probabilities) sizet) ((c-pointer probabilities) :pointer)) - :c-return :pointer - :export nil - :index (letm discrete-random) - :documentation ; FDL - "A pointer to 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.") - -(defmfun discrete-free (table) - "gsl_ran_discrete_free" ((table :pointer)) - :c-return :void - :export nil - :index (letm discrete-random) - :documentation ; FDL - "De-allocates the lookup table created by #'discrete-preprocess.") (defmfun discrete (generator table) "gsl_ran_discrete" @@ -64,14 +38,12 @@ ;;; Examples and unit test (save-test discrete - ;; Must have two letms because the vector value is not set until - ;; the body, but the discrete-random needs that set value. - (letm ((probabilities #m(0.25d0 0.5d0 0.25d0))) - (letm ((table (discrete-random probabilities)) - (rng (random-number-generator *mt19937* 0))) - (loop for i from 0 to 10 - collect - (discrete rng table)))) - (letm ((probabilities #m(0.25d0 0.5d0 0.25d0))) - (letm ((table (discrete-random probabilities))) - (discrete-pdf 1 table)))) + (let* ((probabilities #m(0.25d0 0.5d0 0.25d0)) + (table (make-discrete-random probabilities)) + (rng (make-random-number-generator *mt19937* 0))) + (loop for i from 0 to 10 + collect + (discrete rng table))) + (let* ((probabilities #m(0.25d0 0.5d0 0.25d0)) + (table (make-discrete-random probabilities))) + (discrete-pdf 1 table))) diff --git a/random/exponential-power.lisp b/random/exponential-power.lisp index 121e4088ecaeb0c7a03cda5089f15aa1f26f1fe1..d1ff2703a1c5c05b2f0e64f7c74575d92f54f766 100644 --- a/random/exponential-power.lisp +++ b/random/exponential-power.lisp @@ -1,6 +1,6 @@ ;; Exponential power distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 13:23:31EDT exponential-power.lisp> +;; Time-stamp: <2008-12-26 11:41:54EST exponential-power.lisp> ;; $Id$ (in-package :gsl) @@ -44,7 +44,7 @@ ;;; Examples and unit test (save-test exponential-power - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (exponential-power rng 1.0d0 2.0d0))) diff --git a/random/exponential.lisp b/random/exponential.lisp index 8b129d7db984d5352fa873fa26c9dae77331574d..e3384c93b7c502c7a110da456deab99a6eaade13 100644 --- a/random/exponential.lisp +++ b/random/exponential.lisp @@ -1,6 +1,6 @@ ;; Exponential distribution ;; Liam Healy, Sat Sep 2 2006 - 19:04 -;; Time-stamp: <2008-10-25 13:21:30EDT exponential.lisp> +;; Time-stamp: <2008-12-26 11:45:08EST exponential.lisp> ;; $Id$ (in-package :gsl) @@ -53,7 +53,7 @@ ;;; Examples and unit test (save-test exponential - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (exponential rng 10.0d0))) diff --git a/random/fdist.lisp b/random/fdist.lisp index 5b4d6b749aa3a789e7fb663a20d16486f12cfaee..1d5604c526e378125811ee180ff814632e1b28c1 100644 --- a/random/fdist.lisp +++ b/random/fdist.lisp @@ -1,6 +1,6 @@ ;; Fdist distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 13:25:15EDT fdist.lisp> +;; Time-stamp: <2008-12-26 11:45:12EST fdist.lisp> ;; $Id$ (in-package :gsl) @@ -61,7 +61,7 @@ ;;; Examples and unit test (save-test fdist - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (fdist rng 1.0d0 2.0d0))) diff --git a/random/flat.lisp b/random/flat.lisp index 5f19b8f9694fc45412d07aede94471c6874e949e..dad5bc3bd8725b367a72cd039d16732d93d83acf 100644 --- a/random/flat.lisp +++ b/random/flat.lisp @@ -1,6 +1,6 @@ ;; Flat distribution ;; Liam Healy, Oct 7 2006 -;; Time-stamp: <2008-10-25 13:26:12EDT flat.lisp> +;; Time-stamp: <2008-12-26 11:38:55EST flat.lisp> ;; $Id$ (in-package :gsl) @@ -53,7 +53,7 @@ ;;; Examples and unit test (save-test flat - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (flat rng 1.0d0 2.0d0))) diff --git a/random/gamma.lisp b/random/gamma.lisp index 2749ac79a3762930b466f30bed1a530d9c835561..602e7e8945a61721bc47dc90cad39bc0480df1e2 100644 --- a/random/gamma.lisp +++ b/random/gamma.lisp @@ -1,6 +1,6 @@ ;; Gamma distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 13:30:58EDT gamma.lisp> +;; Time-stamp: <2008-12-26 11:45:09EST gamma.lisp> ;; $Id$ (in-package :gsl) @@ -63,11 +63,11 @@ ;;; Examples and unit test (save-test gamma-randist - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (gamma-rd rng 1.0d0 2.0d0))) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (gamma-mt rng 1.0d0 2.0d0))) diff --git a/random/gaussian-bivariate.lisp b/random/gaussian-bivariate.lisp index 44cc69028b098e2c170df8a51b2986fe3bbb80c0..fc2b0ce7a8783d7f712dcfe740d0aa3132244640 100644 --- a/random/gaussian-bivariate.lisp +++ b/random/gaussian-bivariate.lisp @@ -1,6 +1,6 @@ ;; Gaussian bivariate distribution ;; Liam Healy, Sat Sep 2 2006 - 16:32 -;; Time-stamp: <2008-11-15 22:36:38EST gaussian-bivariate.lisp> +;; Time-stamp: <2008-12-26 11:45:07EST gaussian-bivariate.lisp> ;; $Id$ (in-package :gsl) @@ -34,7 +34,7 @@ ;;; Examples and unit test (save-test gaussian-bivariate - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (bivariate-gaussian rng 1.0d0 0.75d0 0.25d0))) diff --git a/random/gaussian-tail.lisp b/random/gaussian-tail.lisp index 470423b4470e4fd9ae526c05203a33d9cadfad51..ef2db596800998802175fd887d1b0acfdd16d53d 100644 --- a/random/gaussian-tail.lisp +++ b/random/gaussian-tail.lisp @@ -1,6 +1,6 @@ ;; Gaussian tail distribution ;; Liam Healy, Mon Aug 21 2006 - 21:52 -;; Time-stamp: <2008-10-25 13:33:16EDT gaussian-tail.lisp> +;; Time-stamp: <2008-12-26 11:45:11EST gaussian-tail.lisp> ;; $Id$ (in-package :gsl) @@ -46,12 +46,12 @@ ;;; Examples and unit test (save-test gaussian-tail - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (gaussian-tail rng 50.0d0 10.0d0))) (gaussian-tail-pdf 52.0d0 50.0d0 10.0d0) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (ugaussian-tail rng 5.0d0))) diff --git a/random/gaussian.lisp b/random/gaussian.lisp index 048b9dbe5571a03a16c58cb91835536507f5d6af..5018456d9fd865344ec003d6ab980f00e053a739 100644 --- a/random/gaussian.lisp +++ b/random/gaussian.lisp @@ -1,6 +1,6 @@ ;; Gaussian distribution ;; Liam Healy, Sun Jul 16 2006 - 22:09 -;; Time-stamp: <2008-10-25 13:30:56EDT gaussian.lisp> +;; Time-stamp: <2008-12-26 11:45:12EST gaussian.lisp> ;; $Id$ (in-package :gsl) @@ -128,12 +128,12 @@ ;;; Examples and unit test (save-test gaussian - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (gaussian rng 10.0d0))) (gaussian-pdf 0.0d0 10.0d0) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (gaussian-ziggurat rng 10.0d0))) diff --git a/random/generators.lisp b/random/generators.lisp index 516cf79427c1141d02f3011a2cda8dab051f143e..2fe5505f92d8bc98989d31a65c4c972534ac5488 100644 --- a/random/generators.lisp +++ b/random/generators.lisp @@ -1,6 +1,6 @@ ;; Generators of random numbers. ;; Liam Healy, Sat Jul 15 2006 - 14:43 -;; Time-stamp: <2008-12-25 22:49:25EST generators.lisp> +;; Time-stamp: <2008-12-26 11:36:03EST generators.lisp> ;; $Id$ (in-package :gsl) @@ -174,10 +174,9 @@ ;;;;**************************************************************************** (save-test random-number-generators - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (uniform-fixnum rng 1000))) - (letm ((rng (random-number-generator *cmrg* 0))) + (let ((rng (make-random-number-generator *cmrg* 0))) (loop for i from 0 to 10 collect (uniform rng)))) - diff --git a/random/geometric.lisp b/random/geometric.lisp index 7ed944bf3979b0626f93a41817047361fb764d44..f30b5e9fb985d2370b4bb9744d8be9ac11a2b103 100644 --- a/random/geometric.lisp +++ b/random/geometric.lisp @@ -1,6 +1,6 @@ ;; Geometric distribution ;; Liam Healy, Sat Nov 25 2006 - 16:00 -;; Time-stamp: <2008-10-25 13:35:34EDT geometric.lisp> +;; Time-stamp: <2008-12-26 11:41:51EST geometric.lisp> ;; $Id$ (in-package :gsl) @@ -42,7 +42,7 @@ ;;; Examples and unit test (save-test geometric - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (geometric rng 0.4d0))) diff --git a/random/gumbel1.lisp b/random/gumbel1.lisp index 904f62cb99783332b28b1e8f18427be2c59772e5..a5083ce4f5b1d718b639277975edf7d97007e9ec 100644 --- a/random/gumbel1.lisp +++ b/random/gumbel1.lisp @@ -1,6 +1,6 @@ ;; The Gumbel type 1 random number distribution ;; Liam Healy, Sun Oct 29 2006 -;; Time-stamp: <2008-10-25 13:37:01EDT gumbel1.lisp> +;; Time-stamp: <2008-12-26 11:48:46EST gumbel1.lisp> ;; $Id$ (in-package :gsl) @@ -57,7 +57,7 @@ ;;; Examples and unit test (save-test gumbel1 - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (gumbel1 rng 1.0d0 2.0d0))) (gumbel1-pdf 0.1d0 1.0d0 2.0d0) diff --git a/random/gumbel2.lisp b/random/gumbel2.lisp index 0cff266aa96fdab87a2132370d9c2c62f2e469d2..9309865302eb10057919c5001b4209c58db77163 100644 --- a/random/gumbel2.lisp +++ b/random/gumbel2.lisp @@ -1,6 +1,6 @@ ;; The Gumbel type 2 random number distribution ;; Liam Healy, Sun Oct 29 2006 -;; Time-stamp: <2008-10-25 13:38:04EDT gumbel2.lisp> +;; Time-stamp: <2008-12-26 11:45:10EST gumbel2.lisp> ;; $Id$ (in-package :gsl) @@ -55,7 +55,7 @@ ;;; Examples and unit test (save-test gumbel2 - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (gumbel2 rng 1.0d0 2.0d0))) diff --git a/random/hypergeometric.lisp b/random/hypergeometric.lisp index 95673b9b4a2be4d6af025ec337f89dafca8dca40..f07fa3c31dae579bc2dd98fff20d8db443cbba4e 100644 --- a/random/hypergeometric.lisp +++ b/random/hypergeometric.lisp @@ -1,6 +1,6 @@ ;; Hypergeometric distribution ;; Liam Healy, Sat Nov 25 2006 - 16:00 -;; Time-stamp: <2008-10-25 13:39:43EDT hypergeometric.lisp> +;; Time-stamp: <2008-12-26 11:45:11EST hypergeometric.lisp> ;; $Id$ (in-package :gsl) @@ -47,7 +47,7 @@ ;;; Examples and unit test (save-test hypergeometric-randist - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (hypergeometric rng 3 6 3))) diff --git a/random/landau.lisp b/random/landau.lisp index 39031dd792df8faae282b16bf95011c9dc02fa4d..d14b87fa921843f8cc0314365b3baac51860bc84 100644 --- a/random/landau.lisp +++ b/random/landau.lisp @@ -1,6 +1,6 @@ ;; Landau distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 13:41:16EDT landau.lisp> +;; Time-stamp: <2008-12-26 11:38:58EST landau.lisp> ;; $Id$ (in-package :gsl) @@ -28,7 +28,7 @@ ;;; Examples and unit test (save-test landau - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (landau rng))) (landau-pdf 0.25d0)) diff --git a/random/laplace.lisp b/random/laplace.lisp index de57514aeef1e390742725e4e4271d6e4cc7da6c..d114dc3e7fab5c0489bcaa7ccc55662c80760b38 100644 --- a/random/laplace.lisp +++ b/random/laplace.lisp @@ -1,6 +1,6 @@ ;; Exponential distribution ;; Liam Healy, Sun Sep 17 2006 -;; Time-stamp: <2008-10-25 13:42:41EDT laplace.lisp> +;; Time-stamp: <2008-12-26 11:41:52EST laplace.lisp> ;; $Id$ (in-package :gsl) @@ -53,7 +53,7 @@ ;;; Examples and unit test (save-test laplace - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (laplace rng 10.0d0))) diff --git a/random/levy.lisp b/random/levy.lisp index 2c8234751ef6922df0e8eb057bec5de1163d2a2e..6f6e37f9bb037ddcd2fd7642620e06cc55f7b4c9 100644 --- a/random/levy.lisp +++ b/random/levy.lisp @@ -1,6 +1,6 @@ ;; Levy distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 17:52:43EDT levy.lisp> +;; Time-stamp: <2008-12-26 11:45:09EST levy.lisp> ;; $Id$ (in-package :gsl) @@ -44,11 +44,11 @@ ;;; Examples and unit test (save-test levy - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (levy rng 1.0d0 2.0d0))) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (levy-skew rng 1.0d0 2.0d0 1.0d0)))) diff --git a/random/logarithmic.lisp b/random/logarithmic.lisp index fae4e3e2aa1aeb4ba98308559eb61a81f70f464c..d1350343e953ed3bab542603a32bd46aa11d6ed4 100644 --- a/random/logarithmic.lisp +++ b/random/logarithmic.lisp @@ -1,6 +1,6 @@ ;; Logarithmic distribution ;; Liam Healy, Sat Nov 25 2006 - 16:00 -;; Time-stamp: <2008-10-25 17:53:40EDT logarithmic.lisp> +;; Time-stamp: <2008-12-26 11:41:53EST logarithmic.lisp> ;; $Id$ (in-package :gsl) @@ -25,7 +25,7 @@ ;;; Examples and unit test (save-test logarithmic - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (logarithmic rng 0.9d0))) diff --git a/random/logistic.lisp b/random/logistic.lisp index 828d06ea22852549f515c789a57ec8120190eb0b..025b090ef5fafc40e996ffcf13756ca8f346c656 100644 --- a/random/logistic.lisp +++ b/random/logistic.lisp @@ -1,6 +1,6 @@ ;; Logistic distribution ;; Liam Healy, Sat Oct 7 2006 - 16:13 -;; Time-stamp: <2008-10-25 17:54:29EDT logistic.lisp> +;; Time-stamp: <2008-12-26 11:45:08EST logistic.lisp> ;; $Id$ (in-package :gsl) @@ -52,7 +52,7 @@ ;;; Examples and unit test (save-test logistic - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (logistic rng 10.0d0))) diff --git a/random/lognormal.lisp b/random/lognormal.lisp index 8752667fd1ab519d09d77fef4a88f04f77d6cfd6..f865f08ea7ac121be35eb27a8f7ee11289e24e1d 100644 --- a/random/lognormal.lisp +++ b/random/lognormal.lisp @@ -1,6 +1,6 @@ ;; Lognormal distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-11-15 22:37:16EST lognormal.lisp> +;; Time-stamp: <2008-12-26 11:41:53EST lognormal.lisp> ;; $Id$ (in-package :gsl) @@ -56,7 +56,7 @@ ;;; Examples and unit test (save-test lognormal - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (lognormal rng 1.0d0 2.0d0))) diff --git a/random/multinomial.lisp b/random/multinomial.lisp index 2ae915bb69b0b1346f49c78b7e9858fc89e453ff..e951224838ebbfe5f007bd64708f503594b2ff99 100644 --- a/random/multinomial.lisp +++ b/random/multinomial.lisp @@ -1,6 +1,6 @@ ;; Multinomial distribution ;; Liam Healy, Sat Nov 25 2006 - 16:00 -;; Time-stamp: <2008-12-26 10:28:20EST multinomial.lisp> +;; Time-stamp: <2008-12-26 11:45:06EST multinomial.lisp> ;; $Id$ (in-package :gsl) @@ -49,14 +49,14 @@ ;;; Examples and unit test (save-test multinomial - (letm ((rng (random-number-generator *mt19937* 0)) + (let ((rng (make-random-number-generator *mt19937* 0)) (p #m(0.1d0 0.2d0 0.3d0 0.4d0)) (n (make-marray '(signed-byte 32) :dimensions 4))) (multinomial rng 8 p n) (cl-array n)) - (letm ((p #m(0.1d0 0.2d0 0.3d0 0.4d0)) + (let ((p #m(0.1d0 0.2d0 0.3d0 0.4d0)) (n #31m(5 0 1 2))) (multinomial-pdf p N)) - (letm ((p #m(0.1d0 0.2d0 0.3d0 0.4d0)) + (let ((p #m(0.1d0 0.2d0 0.3d0 0.4d0)) (n #31m(5 0 1 2))) (multinomial-log-pdf p n))) diff --git a/random/negative-binomial.lisp b/random/negative-binomial.lisp index 7b7ebf499cdccbb73537637d02529fe5bdf5320c..df5b9ea817e992d4eea7142edd583fb4e57fcc9a 100644 --- a/random/negative-binomial.lisp +++ b/random/negative-binomial.lisp @@ -1,6 +1,6 @@ ;; Negative binomial and Pascal distributions ;; Liam Healy, Sat Nov 25 2006 - 16:00 -;; Time-stamp: <2008-11-15 22:37:16EST negative-binomial.lisp> +;; Time-stamp: <2008-12-26 11:38:56EST negative-binomial.lisp> ;; $Id$ (in-package :gsl) @@ -89,14 +89,14 @@ ;;;;**************************************************************************** (save-test negative-binomial - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (negative-binomial rng 0.4d0 12.0d0))) (negative-binomial-pdf 5 0.4d0 12.0d0) (negative-binomial-P 5 0.4d0 12.0d0) (negative-binomial-Q 5 0.4d0 12.0d0) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (pascal rng 0.4d0 12))) diff --git a/random/pareto.lisp b/random/pareto.lisp index e86f324e9e2daa75ade2b1a54c4e6d1750d6c070..17dda1d36c7e5bdc27326f64aa49980e3a5befd1 100644 --- a/random/pareto.lisp +++ b/random/pareto.lisp @@ -1,6 +1,6 @@ ;; Pareto distribution ;; Liam Healy, Sat Oct 8 2006 - 21:23 -;; Time-stamp: <2008-10-25 18:07:27EDT pareto.lisp> +;; Time-stamp: <2008-12-26 11:45:07EST pareto.lisp> ;; $Id$ (in-package :gsl) @@ -53,7 +53,7 @@ ;;; Examples and unit test (save-test pareto - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (pareto rng 1.0d0 2.0d0))) diff --git a/random/poisson.lisp b/random/poisson.lisp index 062d54ea74dd938f6f5b93c3448370d9733fe15a..f37c116944631ea8d10f7fa1b2d28dd3cd14bbbe 100644 --- a/random/poisson.lisp +++ b/random/poisson.lisp @@ -1,6 +1,6 @@ ;; Poisson distribution ;; Liam Healy, Sat Nov 25 2006 - 16:00 -;; Time-stamp: <2008-10-25 18:08:19EDT poisson.lisp> +;; Time-stamp: <2008-12-26 11:46:06EST poisson.lisp> ;; $Id$ (in-package :gsl) @@ -39,7 +39,7 @@ ;;; Examples and unit test (save-test poisson - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (poisson rng 10.0d0))) diff --git a/random/quasi.lisp b/random/quasi.lisp index 935fded7ee0f80273245e3a53cd110c6c48f4f81..c426259e163c88756e54ab0ad61cd25d3512ab09 100644 --- a/random/quasi.lisp +++ b/random/quasi.lisp @@ -1,6 +1,6 @@ ;; Quasi-random sequences in arbitrary dimensions. ;; Liam Healy, Sun Jul 16 2006 - 15:54 -;; Time-stamp: <2008-12-26 10:28:22EST quasi.lisp> +;; Time-stamp: <2008-12-26 11:36:28EST quasi.lisp> ;; $Id$ (in-package :gsl) @@ -81,7 +81,7 @@ ;;; Examples and unit test (save-test quasi-random-number-generators ;; This example is given in the GSL documentation - (letm ((gen (quasi-random-number-generator 2 *sobol*)) + (let ((gen (make-quasi-random-number-generator 2 *sobol*)) (vec (make-marray 'double-float :dimensions 2))) (loop repeat 5 do (qrng-get gen vec) diff --git a/random/rayleigh-tail.lisp b/random/rayleigh-tail.lisp index ee3f3f0b02c4a076356182cdbc2bc7596be71c98..a8f1e19cd20761a5726f5d3d3b5e2be5809d8e64 100644 --- a/random/rayleigh-tail.lisp +++ b/random/rayleigh-tail.lisp @@ -1,6 +1,6 @@ ;; Rayleigh tail distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 18:16:47EDT rayleigh-tail.lisp> +;; Time-stamp: <2008-12-26 11:48:47EST rayleigh-tail.lisp> ;; $Id$ (in-package :gsl) @@ -26,7 +26,7 @@ ;;; Examples and unit test (save-test rayleigh-tail - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (rayleigh-tail rng 1.0d0 10.0d0))) (rayleigh-tail-pdf 0.25d0 -2.0d0 2.0d0)) diff --git a/random/rayleigh.lisp b/random/rayleigh.lisp index a77c1c8fa1bffbbf4cc0bcfed40d9c5d4ef6e1c9..3c1da069fa78a54391671c82b116434c456f76d7 100644 --- a/random/rayleigh.lisp +++ b/random/rayleigh.lisp @@ -1,6 +1,6 @@ ;; Rayleigh distribution ;; Liam Healy, Sat Sep 30 2006 -;; Time-stamp: <2008-10-25 18:11:18EDT rayleigh.lisp> +;; Time-stamp: <2008-12-26 11:38:57EST rayleigh.lisp> ;; $Id$ (in-package :gsl) @@ -57,7 +57,7 @@ ;;; Examples and unit test (save-test rayleigh - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (rayleigh rng 10.0d0))) diff --git a/random/shuffling-sampling.lisp b/random/shuffling-sampling.lisp index 09db95d6b86f33805355ca3bc8f85d06949d2537..b792dc1987bfe33ecae026a028ab09e83237944e 100644 --- a/random/shuffling-sampling.lisp +++ b/random/shuffling-sampling.lisp @@ -1,6 +1,6 @@ ;; Shuffling and sampling ;; Liam Healy, Sat Dec 2 2006 - 18:40 -;; Time-stamp: <2008-12-26 10:28:21EST shuffling-sampling.lisp> +;; Time-stamp: <2008-12-26 12:43:16EST shuffling-sampling.lisp> ;; $Id$ (in-package :gsl) @@ -42,7 +42,7 @@ same relative order as those in src. You will need to call #'shuffle if you want to randomize the order.") -(defmfun sample (generator dest src) +(defmfun random-sample (generator dest src) "gsl_ran_sample" (((generator generator) :pointer) ((c-pointer dest) :pointer) ((dim0 dest) sizet) @@ -57,17 +57,17 @@ ;;; Examples and unit test (save-test shuffling-sampling - (letm ((rng (random-number-generator *mt19937* 0)) + (let ((rng (make-random-number-generator *mt19937* 0)) (v1 #31m(1 2 3 4 5 6 7 8))) (shuffle rng v1) (cl-array v1)) - (letm ((rng (random-number-generator *mt19937* 0)) + (let ((rng (make-random-number-generator *mt19937* 0)) (v1 #31m(1 2 3 4 5 6 7 8)) (v2 (make-marray '(signed-byte 32) :dimensions 4))) (choose-random rng v2 v1) (cl-array v2)) - (letm ((rng (random-number-generator *mt19937* 0)) + (let ((rng (make-random-number-generator *mt19937* 0)) (v1 #31m(1 2 3 4 5 6 7 8)) (v2 (make-marray '(signed-byte 32) :dimensions 10))) - (sample rng v2 v1) + (random-sample rng v2 v1) (cl-array v2))) diff --git a/random/spherical-vector.lisp b/random/spherical-vector.lisp index a8be9fb1f83e94fa57e364ad2316f5125ecbc455..ee0ca8aec78c7bdccad0bdb7b5201be1fcebfcb7 100644 --- a/random/spherical-vector.lisp +++ b/random/spherical-vector.lisp @@ -1,6 +1,6 @@ ;; Spherical Vector distribution ;; Liam Healy, Sun Oct 22 2006 -;; Time-stamp: <2008-10-25 18:17:49EDT spherical-vector.lisp> +;; Time-stamp: <2008-12-26 11:45:05EST spherical-vector.lisp> ;; $Id$ (in-package :gsl) @@ -57,15 +57,15 @@ ;;; Examples and unit test (save-test spherical-vector - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 4 append (multiple-value-list (direction-2d rng)))) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 4 append (multiple-value-list (direction-2d-trig-method rng)))) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 2 append (multiple-value-list (direction-3d rng))))) diff --git a/random/tdist.lisp b/random/tdist.lisp index c0a7f994880c8fa6d165a6ee0774c3b6c925a1cf..e9157af3ed0a27afe2efbe57800cbb0e4c71fa1d 100644 --- a/random/tdist.lisp +++ b/random/tdist.lisp @@ -1,6 +1,6 @@ ;; Tdist distribution ;; Liam Healy, Sat Oct 7 2006 - 16:13 -;; Time-stamp: <2008-10-25 18:18:44EDT tdist.lisp> +;; Time-stamp: <2008-12-26 11:38:57EST tdist.lisp> ;; $Id$ (in-package :gsl) @@ -54,7 +54,7 @@ ;;; Examples and unit test (save-test tdist - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (rng-set rng 0) (loop for i from 0 to 10 collect diff --git a/random/weibull.lisp b/random/weibull.lisp index e1c44209ea5bf02fa1b9b6ab7a6675ee7b29cb25..59186251250c9380f69155bddf3b1616fe8b57c6 100644 --- a/random/weibull.lisp +++ b/random/weibull.lisp @@ -1,6 +1,6 @@ ;; Weibull distribution ;; Liam Healy, Sun Oct 22 2006 -;; Time-stamp: <2008-10-25 18:20:28EDT weibull.lisp> +;; Time-stamp: <2008-12-26 11:41:55EST weibull.lisp> ;; $Id$ (in-package :gsl) @@ -52,7 +52,7 @@ ;;; Examples and unit test (save-test weibull - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for i from 0 to 10 collect (weibull rng 1.0d0 2.0d0))) diff --git a/series-acceleration.lisp b/series-acceleration.lisp index dba7d5891ca1cc4a6d15ef8244d5779036803ab7..3d025035d0a984bba4ca86286cb0418a8ecf19da 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: <2008-12-26 10:25:49EST series-acceleration.lisp> +;; Time-stamp: <2008-12-26 12:17:53EST series-acceleration.lisp> ;; $Id$ (in-package :gsl) @@ -9,7 +9,7 @@ ;;;; Creation and calculation of Levin series acceleration ;;;;**************************************************************************** -(cffi:defcstruct levin +(cffi:defcstruct levin-c "The definition of Levin series acceleration for GSL." (size sizet) (position-in-array sizet) @@ -21,34 +21,11 @@ (dq-den :pointer) (dsum :pointer)) -#| (defmobject levin "gsl_sum_levin_u" ((order sizet)) "Levin u-transform" ; FDL "Make a workspace for a Levin u-transform of n terms. The size of the workspace is O(2n^2 + 3n).") -|# - -(defgo-s (levin order) allocate-levin free-levin) - -(defmfun allocate-levin (order) - "gsl_sum_levin_u_alloc" - ((order sizet)) - :c-return :pointer - :export nil - :index (letm levin) - :documentation ; FDL - "Allocate a workspace for a Levin u-transform of n - terms. The size of the workspace is O(2n^2 + 3n).") - -(defmfun free-levin (levin) - "gsl_sum_levin_u_free" - ((levin :pointer)) - :c-return :void ; Error in GSL manual, should be void? - :export nil - :index (letm levin) - :documentation ; FDL - "Free a previously allocated Levin acceleration.") (defmfun accelerate (array levin) "gsl_sum_levin_u_accel" @@ -69,35 +46,12 @@ ;;;; Acceleration with error estimation from truncation ;;;;**************************************************************************** -#| (defmobject levin-truncated "gsl_sum_levin_utrunc" ((order sizet)) "truncated Levin u-transform" ; FDL "Make a workspace for a Levin u-transform of n terms, without error estimation. The size of the workspace is O(3n).") -|# - -(defgo-s (levin-truncated order) allocate-levin-truncated free-levin-truncated) - -(defmfun allocate-levin-truncated (order) - "gsl_sum_levin_utrunc_alloc" - ((order sizet)) - :c-return :pointer - :export nil - :index (letm levin-truncated) - :documentation ; FDL - "Allocate a workspace for a Levin u-transform of n - terms, without error estimation. The size of the workspace is - O(3n).") - -(defmfun free-levin-truncated (levin) - "gsl_sum_levin_utrunc_free" - ((levin :pointer)) - :export nil - :index (letm levin-truncated) - :documentation ; FDL - "Free a previously allocated Levin acceleration.") (defmfun accelerate-truncated (array levin) "gsl_sum_levin_utrunc_accel" @@ -126,8 +80,8 @@ (let ((maxterms 20) (sum 0.0d0) (zeta2 (/ (expt pi 2) 6))) - (letm ((levin (levin maxterms)) - (array (make-marray 'double-float :dimensions maxterms))) + (let ((levin (make-levin maxterms)) + (array (make-marray 'double-float :dimensions maxterms))) (dotimes (n maxterms) (setf (maref array n) (coerce (/ (expt (1+ n) 2)) 'double-float)) (incf sum (maref array n))) @@ -135,12 +89,12 @@ (accelerate array levin) (format t "~&term-by-term sum =~f using ~d terms" sum maxterms) (format t "~&term-by-term sum =~f using ~d terms" - (cffi:foreign-slot-value levin 'levin 'sum-plain) - (cffi:foreign-slot-value levin 'levin 'terms-used)) + (cffi:foreign-slot-value levin 'levin-c 'sum-plain) + (cffi:foreign-slot-value levin 'levin-c 'terms-used)) (format t "~&exact value = ~f" zeta2) (format t "~&accelerated sum = ~f using ~d terms" accelerated-sum - (cffi:foreign-slot-value levin 'levin 'terms-used)) + (cffi:foreign-slot-value levin 'levin-c 'terms-used)) (format t "~&estimated error = ~f" error) (format t "~&actual error = ~f" (- accelerated-sum zeta2)))))) diff --git a/solve-minimize-fit/linear-least-squares.lisp b/solve-minimize-fit/linear-least-squares.lisp index 351fb00a181c21cbf66103b3fec694275c47f6c9..c5faa22842fd6e7efac2936c220210336222596c 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-26 10:28:25EST linear-least-squares.lisp> +;; Time-stamp: <2008-12-26 13:26:43EST linear-least-squares.lisp> ;; $Id$ (in-package :gsl) @@ -129,32 +129,11 @@ ;;;; 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) - -(defmfun allocate-fit-workspace (number-of-observations number-of-parameters) - "gsl_multifit_linear_alloc" - ((number-of-observations sizet) (number-of-parameters sizet)) - :c-return :pointer - :index (letm fit-workspace) - :documentation ; FDL - "Allocate a workspace for fitting a linear model.") - -(defmfun free-fit-workspace (pointer) - "gsl_multifit_linear_free" - ((pointer :pointer)) - :c-return :void - :index (letm fit-workspace) - :documentation ; FDL - "Free the memory associate with the workspace.") (defmfun linear-mfit (model observations parameters covariance tolerance workspace) @@ -279,7 +258,7 @@ (defun univariate-linear-least-squares-example () "First example in Section 36.5 of the GSL manual." ;; Results not given in manual so not verified yet. - (letm ((x #m(1970.0d0 1980.0d0 1990.0d0 2000.0d0)) + (let ((x #m(1970.0d0 1980.0d0 1990.0d0 2000.0d0)) (y #m(12.0d0 11.0d0 14.0d0 13.0d0)) (w #m(0.1d0 0.2d0 0.3d0 0.4d0))) (multiple-value-bind (c0 c1 cov00 cov01 cov11 chisq) @@ -311,7 +290,7 @@ (defun mv-linear-least-squares-data () "Generate data for second example in Section 36.5 of the GSL manual." - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (loop for x from 1/10 below 2 by 1/10 for xd = (coerce x 'double-float) for y0 = (exp xd) @@ -321,7 +300,7 @@ (defun mv-linear-least-squares-example (data) "Second example in Section 36.5 of the GSL manual." - (letm ((n (length data)) chisq + (let* ((n (length data)) chisq (x (make-marray 'double-float :dimensions (list n 3))) (cov (make-marray 'double-float :dimensions '(3 3))) (y (make-marray 'double-float :dimensions n)) @@ -334,7 +313,7 @@ (maref X i 2) (expt (first row) 2) (maref y i) (second row) (maref w i) (/ (expt (third row) 2)))) - (letm ((ws (fit-workspace n 3))) + (let ((ws (make-fit-workspace n 3))) (setf chisq (weighted-linear-mfit X w y c cov ws))) (format t "~&Best fit: Y = ~10,8f + ~10,8f X + ~10,8f X^2" diff --git a/solve-minimize-fit/minimization-multi.lisp b/solve-minimize-fit/minimization-multi.lisp index 0f597f4c57c3f6f146aa5c8cb52c9a8887f7da33..d7f0be4dc368e1c25b66959c8c0cb9a8f7f81565 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-26 10:29:01EST minimization-multi.lisp> +;; Time-stamp: <2008-12-26 12:57:02EST minimization-multi.lisp> ;; $Id$ (in-package :gsl) @@ -48,7 +48,6 @@ ;;;; Initialization ;;;;**************************************************************************** -#| (defmobject multi-dimensional-minimizer-f "gsl_multimin_fminimizer" ((type :pointer) (dimension sizet)) @@ -59,6 +58,7 @@ initial trial steps is given in vector step-size. The precise meaning of this parameter depends on the method used." "set" + ;; Could have one fewer argument: dimension=(dim0 initial) ((function :pointer) ((mpointer initial) :pointer) ((mpointer step-size) :pointer))) @@ -77,86 +77,9 @@ direction p to a relative accuracy of tolerance, where dot(p,g) < tol |p| |g|." "set" + ;; Could have one fewer argument: dimension=(dim0 initial) ((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) -(defgo-s (mfdfminimizer type dimension function-derivative intitial step-size tolerance) - allocate-mfdfminimizer free-mfdfminimizer set-mfdfminimizer 2) - -(defmfun allocate-mfminimizer (type dimension) - "gsl_multimin_fminimizer_alloc" - ((type :pointer) (dimension sizet)) - :c-return :pointer - :export nil - :index (letm mfminimizer) - :documentation ; FDL - "Allocate an instance of a minimizer of the given for an - function of the given dimensions.") - -(defmfun allocate-mfdfminimizer (type dimension) - "gsl_multimin_fdfminimizer_alloc" - ((type :pointer) (dimension sizet)) - :c-return :pointer - :export nil - :index (letm mfdfminimizer) - :documentation ; FDL - "Allocate an instance of a derivative-based minimizer of the given for an - function of the given dimensions.") - -(defmfun set-mfminimizer (minimizer function initial step-size) - "gsl_multimin_fminimizer_set" - ((minimizer :pointer) (function :pointer) - ((mpointer initial) :pointer) ((mpointer step-size) :pointer)) - :inputs (initial step-size) - :export nil - :index (letm mfminimizer) - :documentation ; FDL - "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.") - -(defmfun set-mfdfminimizer - (minimizer function-derivative initial step-size tolerance) - "gsl_multimin_fdfminimizer_set" - ((minimizer :pointer) (function-derivative :pointer) - ((mpointer initial) :pointer) (step-size :double) - (tolerance :double)) - :inputs (initial) - :export nil - :index (letm mfdfminimizer) - :documentation ; FDL - "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|.") - -(defmfun free-mfminimizer (minimizer) - "gsl_multimin_fminimizer_free" - ((minimizer :pointer)) - :c-return :void - :export nil - :index (letm mfminimizer) - :documentation ; FDL - "Free all the memory associated with the minimizer.") - -(defmfun free-mfdfminimizer (minimizer) - "gsl_multimin_fdfminimizer_free" - ((minimizer :pointer)) - :c-return :void - :export nil - :index (letm mfdfminimizer) - :documentation ; FDL - "Free all the memory associated with the minimizer.") (defmfun mfminimizer-name (minimizer) "gsl_multimin_fminimizer_name" @@ -380,26 +303,27 @@ parabaloid 2 parabaloid-derivative parabaloid-and-derivative) (defun multimin-example-fletcher-reeves () - (letm ((initial #m(5.0d0 7.0d0)) + (let* ((initial #m(5.0d0 7.0d0)) (minimizer - (mfdfminimizer *conjugate-fletcher-reeves* 2 parabaloid - initial 0.01d0 1.0d-4))) + (make-multi-dimensional-minimizer-fdf + *conjugate-fletcher-reeves* 2 parabaloid + initial 0.01d0 1.0d-4))) (loop with status = T - for iter from 0 below 100 - while status - do - (iterate-mfdfminimizer minimizer) - (setf status - (not (min-test-gradient - (mfdfminimizer-gradient minimizer) - 1.0d-3))) - (let ((x (mfdfminimizer-x minimizer))) - (format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f" - iter (maref x 0) (maref x 1) - (mfdfminimizer-minimum minimizer))) - finally (return - (let ((x (mfdfminimizer-x minimizer))) - (values (maref x 0) (maref x 1))))))) + for iter from 0 below 100 + while status + do + (iterate-mfdfminimizer minimizer) + (setf status + (not (min-test-gradient + (mfdfminimizer-gradient minimizer) + 1.0d-3))) + (let ((x (mfdfminimizer-x minimizer))) + (format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f" + iter (maref x 0) (maref x 1) + (mfdfminimizer-minimum minimizer))) + finally (return + (let ((x (mfdfminimizer-x minimizer))) + (values (maref x 0) (maref x 1))))))) ;;; Because def-minimization-functions bind a symbol ;;; of the same name as the first function, and we want both to run, @@ -410,24 +334,25 @@ (def-minimization-functions parabaloid-f 2) (defun multimin-example-nelder-mead () - (letm ((initial #m(5.0d0 7.0d0)) - (step-size (make-marray 'double-float :dimensions 2))) + (let ((initial #m(5.0d0 7.0d0)) + (step-size (make-marray 'double-float :dimensions 2))) (set-all step-size 1.0d0) - (letm ((minimizer - (mfminimizer *simplex-nelder-mead* 2 parabaloid-f initial step-size))) + (let ((minimizer + (make-multi-dimensional-minimizer-f + *simplex-nelder-mead* 2 parabaloid-f initial step-size))) (loop with status = T and size - for iter from 0 below 100 - while status - do (iterate-mfminimizer minimizer) - (setf size - (mfminimizer-size minimizer) - status - (not (min-test-size size 1.0d-2))) - (let ((x (mfminimizer-x minimizer))) - (format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f" - iter (maref x 0) (maref x 1) - (mfminimizer-minimum minimizer) - size)) - finally (return - (let ((x (mfminimizer-x minimizer))) - (values (maref x 0) (maref x 1)))))))) + for iter from 0 below 100 + while status + do (iterate-mfminimizer minimizer) + (setf size + (mfminimizer-size minimizer) + status + (not (min-test-size size 1.0d-2))) + (let ((x (mfminimizer-x minimizer))) + (format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f" + iter (maref x 0) (maref x 1) + (mfminimizer-minimum minimizer) + size)) + finally (return + (let ((x (mfminimizer-x minimizer))) + (values (maref x 0) (maref x 1)))))))) diff --git a/solve-minimize-fit/minimization-one.lisp b/solve-minimize-fit/minimization-one.lisp index 51848286f7f223f576ececb9158f6a5839894b2c..a1a2d9c5c13f3249ec40f2852ba16bbc99113067 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-12-25 10:22:13EST minimization-one.lisp> +;; Time-stamp: <2008-12-26 13:26:06EST minimization-one.lisp> ;; $Id$ (in-package :gsl) @@ -9,7 +9,6 @@ ;;;; Initialization ;;;;**************************************************************************** -#| ;; The one-dimensional minimizer uses a function (no derivative) only. (defmobject one-dimensional-minimizer "gsl_min_fminimizer" @@ -18,34 +17,9 @@ "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" + "set" ; should use set_with_values? ((function :pointer) (minimum :double) (lower :double) (upper :double))) -|# -(defgo-s (fminimizer type function minimum lower upper) - allocate-fminimizer free-fminimizer set-fminimizer) - -(defmfun allocate-fminimizer (type) - "gsl_min_fminimizer_alloc" - ((type :pointer)) - :c-return :pointer - :export nil - :index (letm fminimizer) - :documentation ; FDL - "Allocate an instance of a minimizer of the given type.") - -(defmfun set-fminimizer (minimizer function minimum lower upper) - "gsl_min_fminimizer_set" - ((minimizer :pointer) (function :pointer) - (minimum :double) (lower :double) (upper :double)) - :export nil - :index (letm fminimizer) - :documentation ; FDL - "Set, or reset, an existing minimizer to use the - function and the initial search interval [lower, - upper], with a guess for the location of the minimum.") - -;;; Use this in letm macro in any way? (defmfun set-fminimizer-with-values (minimizer function x-minimum x-lower x-upper f-minimum f-lower f-upper) @@ -59,15 +33,6 @@ upper], with a guess for the location of the minimum, using supplied rather than computed values of the function.") -(defmfun free-fminimizer (minimizer) - "gsl_min_fminimizer_free" - ((minimizer :pointer)) - :c-return :void - :export nil - :index (letm fminimizer) - :documentation ; FDL - "Free all the memory associated with the minimizer.") - (defmfun fminimizer-name (minimizer) "gsl_min_fminimizer_name" ((minimizer :pointer)) @@ -210,21 +175,22 @@ (defun minimization-one-example () "Solving a minimum, the example given in Sec. 33.8 of the GSL manual." - (letm ((max-iter 100) - (minimizer - (fminimizer *brent-fminimizer* minimization-one-fn 2.0d0 0.0d0 6.0d0))) + (let ((max-iter 100) + (minimizer + (make-one-dimensional-minimizer + *brent-fminimizer* minimization-one-fn 2.0d0 0.0d0 6.0d0))) (format t "~&iter ~6t [lower ~24tupper] ~36tmin ~44tmin err ~54tupper-lower") (loop for iter from 0 - for min = (fminimizer-x-minimum minimizer) - for lower = (fminimizer-x-lower minimizer) - for upper = (fminimizer-x-upper minimizer) - do (iterate-fminimizer minimizer) - while (and (< iter max-iter) - ;; abs and rel error swapped in example? - (not (min-test-interval lower upper 0.001d0 0.0d0))) - do - (format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f ~44t~10,4g ~10,4g" - iter lower upper - min (- min pi) - (- upper lower))))) + for min = (fminimizer-x-minimum minimizer) + for lower = (fminimizer-x-lower minimizer) + for upper = (fminimizer-x-upper minimizer) + do (iterate-fminimizer minimizer) + while (and (< iter max-iter) + ;; abs and rel error swapped in example? + (not (min-test-interval lower upper 0.001d0 0.0d0))) + do + (format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f ~44t~10,4g ~10,4g" + iter lower upper + min (- min pi) + (- upper lower))))) diff --git a/solve-minimize-fit/nonlinear-least-squares.lisp b/solve-minimize-fit/nonlinear-least-squares.lisp index fba456c3b0dd48ac73877c7386ec50f695d72773..e14348f1c820d4d59d0912f6fc341c7811fedf5d 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: <2008-12-26 10:25:45EST nonlinear-least-squares.lisp> +;; Time-stamp: <2008-12-26 12:56:25EST nonlinear-least-squares.lisp> ;; $Id$ (in-package :gsl) @@ -12,44 +12,12 @@ ;;; Note that there are currently no derivative-free solvers provided, ;;; so this is a bit pointless. -#| (defmobject nonlinear-ffit "gsl_multifit_fsolver" ((solver-type :pointer) (number-of-observations sizet) (number-of-parameters sizet)) "nonlinear least squares fit with function only" ; FDL "The number of observations must be greater than or equal to parameters." "set" ((function :pointer) ((mpointer initial-guess) :pointer))) -|# - -(defgo-s (nonlinear-ffit solver-type number-of-observations number-of-parameters - function initial-guess) - allocate-ffit free-ffit set-ffit 3) - -(defmfun allocate-ffit (solver-type number-of-observations number-of-parameters) - "gsl_multifit_fsolver_alloc" - ((solver-type :pointer) (number-of-observations sizet) (number-of-parameters sizet)) - :c-return :pointer - :export nil - :index (letm nonlinear-ffit) - :documentation ; FDL - "Allocate an instance of a solver. The number of observations - must be greater than or equal to parameters.") - -(defmfun set-ffit (solver function initial-guess) - "gsl_multifit_fsolver_set" - ((solver :pointer) (function :pointer) (initial-guess :pointer)) - :documentation ; FDL - "Initialize or reinitialize an existing solver - to use the function and the initial guess.") - -(defmfun free-ffit (solver) - "gsl_multifit_fsolver_free" - ((solver :pointer)) - :c-return :void - :export nil - :index (letm nonlinear-ffit) - :documentation ; FDL - "Free all the memory associated with the solver.") (defmfun name-ffit (solver) "gsl_multifit_fsolver_name" @@ -62,7 +30,6 @@ ;;;; Function and derivative solver object ;;;;**************************************************************************** -#| (defmobject nonlinear-fdffit "gsl_multifit_fsolver" ((solver-type :pointer) (number-of-observations sizet) (number-of-parameters sizet)) "nonlinear least squares fit with function and derivative" ; FDL @@ -70,37 +37,6 @@ equal to parameters." "set" ((function :pointer) ((mpointer initial-guess) :pointer))) -|# - -(defgo-s (nonlinear-fdffit solver-type number-of-observations number-of-parameters - functions initial-guess) - allocate-fdffit free-fdffit set-fdffit 3) - -(defmfun allocate-fdffit (solver-type number-of-observations number-of-parameters) - "gsl_multifit_fdfsolver_alloc" - ((solver-type :pointer) (number-of-observations sizet) (number-of-parameters sizet)) - :c-return :pointer - :export nil - :index (letm nonlinear-fdffit) - :documentation ; FDL - "Allocate an instance of a solver. The number of observations - must be greater than or equal to parameters.") - -(defmfun set-fdffit (solver function initial-guess) - "gsl_multifit_fdfsolver_set" - ((solver :pointer) (function :pointer) ((mpointer initial-guess) :pointer)) - :documentation ; FDL - "Initialize or reinitialize an existing solver - to use the function and the initial guess.") - -(defmfun free-fdffit (solver) - "gsl_multifit_fdfsolver_free" - ((solver :pointer)) - :c-return :void - :export nil - :index (letm nonlinear-fdffit) - :documentation ; FDL - "Free all the memory associated with the solver.") (defmfun name-fdffit (solver) "gsl_multifit_fdfsolver_name" @@ -356,7 +292,7 @@ :n *number-of-observations* :y (let ((arr (make-marray *number-of-observations* 'double-float))) - (letm ((rng (random-number-generator *mt19937* 0))) + (let ((rng (make-random-number-generator *mt19937* 0))) (dotimes (i *number-of-observations* arr) (setf (aref arr i) (+ 1 (* 5 (exp (* -1/10 i))) (gaussian rng 0.1d0)))))) @@ -410,12 +346,12 @@ (euclidean-norm (fdffit-slot fit 'f))) (defun solve-nonlinear-least-squares-example () - (letm ((init #m(1.0d0 0.0d0 0.0d0)) + (let* ((init #m(1.0d0 0.0d0 0.0d0)) (covariance (make-marray 'double-float :dimensions (list *number-of-parameters* *number-of-parameters*))) - (fit (nonlinear-fdffit + (fit (make-nonlinear-fdffit *levenberg-marquardt* *number-of-observations* *number-of-parameters* diff --git a/solve-minimize-fit/roots-multi.lisp b/solve-minimize-fit/roots-multi.lisp index e50ed37ac41d004d4bc6ffa42c538531f8a6745d..29ea6865beea110767c1d2dccd1e14a832f22257 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-25 12:04:09EST roots-multi.lisp> +;;; Time-stamp: <2008-12-26 13:28:05EST roots-multi.lisp> ;;; $Id$ (in-package :gsl) @@ -37,7 +37,6 @@ ;;;; Initialization ;;;;**************************************************************************** -#| (defmobject multi-dimensional-root-solver-f "gsl_multiroot_fsolver" ((type :pointer) (dimension sizet)) "multi-dimensional root solver with function only" ; FDL @@ -48,7 +47,7 @@ "set" ((function :pointer) ((mpointer initial) :pointer)) (lambda (set) - `((type &optional function-or-dimension (initial ,set)) + `((type &optional function-or-dimension (initial nil ,set)) (:type type :dimension (if ,set (dim0 initial) function-or-dimension)) @@ -65,86 +64,12 @@ "set" ((function-derivative :pointer) ((mpointer initial) :pointer)) (lambda (set) - `((type &optional function-or-dimension (initial ,set)) + `((type &optional function-or-dimension (initial nil ,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)) - 'free-mfsolver - (lambda (symb) - `(set-mfsolver ,symb ,function-derivative ,initial)))) - -(defgo mfdfsolver (type function-derivative initial) - (list - `(allocate-mfdfsolver ,type (dim0 ,initial)) - 'free-mfdfsolver - (lambda (symb) - `(set-mfdfsolver ,symb ,function-derivative ,initial)))) - -(defmfun allocate-mfsolver (type dimension) - "gsl_multiroot_fsolver_alloc" - ((type :pointer) (dimension sizet)) - :c-return :pointer - :export nil - :index (letm mfsolver) - :documentation ; FDL - "Allocate an instance of a solver of the type specified for a system of - the specified number of dimensions.") - -(defmfun allocate-mfdfsolver (type dimension) - "gsl_multiroot_fdfsolver_alloc" - ((type :pointer) (dimension sizet)) - :c-return :pointer - :export nil - :index (letm mfdfsolver) - :documentation ; FDL - "Allocate an instance of a derivative solver of the type specified for - a system of the specified number of dimensions.") - -(defmfun set-mfsolver (solver function initial) - "gsl_multiroot_fsolver_set" - ((solver :pointer) (function :pointer) ((mpointer initial) :pointer)) - :inputs (initial) - :export nil - :index (letm mfsolver) - :documentation ; FDL - "Set or reset an existing solver to use the function and the - initial guess gsl-vector.") - -(defmfun set-mfdfsolver (solver function-derivative initial) - "gsl_multiroot_fdfsolver_set" - ((solver :pointer) (function-derivative :pointer) - ((mpointer initial) :pointer)) - :inputs (initial) - :export nil - :index (letm mfdfsolver) - :documentation ; FDL - "Set or reset an existing solver to use the function and derivative - (fdf) and the initial guess.") - -(defmfun free-mfsolver (solver) - "gsl_multiroot_fsolver_free" - ((solver :pointer)) - :c-return :void - :export nil - :index (letm mfsolver) - :documentation ; FDL - "Free all the memory associated with the solver.") - -(defmfun free-mfdfsolver (solver) - "gsl_multiroot_fdfsolver_free" - ((solver :pointer)) - :c-return :void - :export nil - :index (letm mfdfsolver) - :documentation ; FDL - "Free all the memory associated with the solver.") (defmfun mfsolver-name (solver) "gsl_multiroot_fsolver_name" @@ -461,8 +386,9 @@ (defun roots-multi-example () "Solving Rosenbrock, the example given in Sec. 34.8 of the GSL manual." (let ((max-iter 1000)) - (letm ((vect #m(a -10.0d0 -5.0d0)) - (solver (mfsolver *hybrid-scaled* rosenbrock vect))) + (let* ((vect #m(a -10.0d0 -5.0d0)) + (solver (make-multi-dimensional-root-solver-f + *hybrid-scaled* rosenbrock vect))) (loop for iter from 0 with fnval and argval while (and (< iter max-iter) @@ -514,22 +440,22 @@ (maref fnval 0) (maref fnval 1)))) (let ((max-iter 1000)) - (letm ((vect #m(a -10.0d0 -5.0d0))) - (letm - ((solver (mfdfsolver *gnewton-mfdfsolver* rosenbrock-f vect))) - (loop for iter from 0 - with fnval = (mfdfsolver-f solver) - and argval = (mfdfsolver-root solver) - while (and (< iter max-iter) - (not (multiroot-test-residual solver 1.0d-7))) - initially (print-state iter argval fnval) - do - (iterate-mfdfsolver solver) - (setf fnval (mfdfsolver-f solver) - argval (mfdfsolver-root solver)) - (print-state iter argval fnval) - finally (return - (values (maref argval 0) - (maref argval 1) - (maref fnval 0) - (maref fnval 1))))))))) + (let* ((vect #m(a -10.0d0 -5.0d0)) + (solver (make-multi-dimensional-root-solver-fdf + *gnewton-mfdfsolver* rosenbrock-f vect))) + (loop for iter from 0 + with fnval = (mfdfsolver-f solver) + and argval = (mfdfsolver-root solver) + while (and (< iter max-iter) + (not (multiroot-test-residual solver 1.0d-7))) + initially (print-state iter argval fnval) + do + (iterate-mfdfsolver solver) + (setf fnval (mfdfsolver-f solver) + argval (mfdfsolver-root solver)) + (print-state iter argval fnval) + finally (return + (values (maref argval 0) + (maref argval 1) + (maref fnval 0) + (maref fnval 1)))))))) diff --git a/solve-minimize-fit/roots-one.lisp b/solve-minimize-fit/roots-one.lisp index fa639faad1147539e763688fa3753e89aba15e0c..1f6d469fa4f931c032920dc9ae186978152817e6 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-25 10:14:02EST roots-one.lisp> +;; Time-stamp: <2008-12-26 12:11:19EST roots-one.lisp> ;; $Id$ (in-package :gsl) @@ -44,7 +44,6 @@ ;;;; Initialization ;;;;**************************************************************************** -#| (defmobject one-dimensional-root-solver-f "gsl_root_fsolver" ((type :pointer)) "one-dimensional root solver with function only" ; FDL @@ -58,66 +57,6 @@ "" "set" ((function-derivative :pointer) (root-guess :double))) -|# - -(defgo-s (fsolver type function lower upper) allocate-fsolver free-fsolver set-fsolver) -(defgo-s (fdfsolver type function-derivative root-guess) - allocate-fdfsolver free-fdfsolver set-fdfsolver) - -(defmfun allocate-fsolver (type) - "gsl_root_fsolver_alloc" - ((type :pointer)) - :c-return :pointer - :export nil - :index (letm fsolver) - :documentation ; FDL - "Allocate an instance of a solver of the given type.") - -(defmfun allocate-fdfsolver (type) - "gsl_root_fdfsolver_alloc" - ((type :pointer)) - :c-return :pointer - :export nil - :index (letm fdfsolver) - :documentation ; FDL - "Allocate an instance of a derivative-based solver of the given type.") - -(defmfun set-fsolver (solver function lower upper) - "gsl_root_fsolver_set" - ((solver :pointer) (function :pointer) - (lower :double) (upper :double)) - :export nil - :index (letm fsolver) - :documentation ; FDL - "Initialize or reinitialize an existing solver - to use the function and the initial search interval - [lower, upper].") - -(defmfun set-fdfsolver (solver function-derivative root-guess) - "gsl_root_fdfsolver_set" - ((solver :pointer) (function-derivative :pointer) (root-guess :double)) - :export nil - :index (letm fdfsolver) - :documentation ; FDL - "Initialize or reinitialize an existing solver.") - -(defmfun free-fsolver (solver) - "gsl_root_fsolver_free" - ((solver :pointer)) - :c-return :void - :export nil - :index (letm fsolver) - :documentation ; FDL - "Free all the memory associated with the solver.") - -(defmfun free-fdfsolver (solver) - "gsl_root_fdfsolver_free" - ((solver :pointer)) - :c-return :void - :export nil - :index (letm fdfsolver) - :documentation ; FDL - "Free all the memory associated with the solver.") (defmfun fsolver-name (solver) "gsl_root_fsolver_name" @@ -375,7 +314,7 @@ (defun roots-one-example () "Solving a quadratic, the example given in Sec. 32.10 of the GSL manual." - (letm ((max-iter 50) + (let ((max-iter 50) (solver (fsolver *brent-fsolver* quadratic 0.0d0 5.0d0))) (format t "~&iter ~6t [lower ~24tupper] ~36troot ~44terr ~54terr(est)") (loop for iter from 0 @@ -402,17 +341,18 @@ (defun roots-one-fdf-example () "Solving a quadratic, the example given in Sec. 32.10 of the GSL manual." - (let ((max-iter 100) - (initial 5.0d0)) - (letm ((solver (fdfsolver *newton-fdfsolver* quadratic-df initial))) - (format t "~&iter ~6t ~8troot ~22terr ~34terr(est)") - (loop for iter from 0 - for itres = (iterate-fdfsolver solver) - for oldroot = initial then root - for root = (fdfsolver-root solver) - while (and (< iter max-iter) - (not (root-test-delta root oldroot 0.0d0 1.0d-5))) - do - (format t "~&~d~6t~10,8g ~18t~10,6g~34t~10,6g" - iter root (- root (sqrt 5.0d0)) (- root oldroot)))))) + (let* ((max-iter 100) + (initial 5.0d0) + (solver (make-one-dimensional-root-solver-fdf + *newton-fdfsolver* quadratic-df initial))) + (format t "~&iter ~6t ~8troot ~22terr ~34terr(est)") + (loop for iter from 0 + for itres = (iterate-fdfsolver solver) + for oldroot = initial then root + for root = (fdfsolver-root solver) + while (and (< iter max-iter) + (not (root-test-delta root oldroot 0.0d0 1.0d-5))) + do + (format t "~&~d~6t~10,8g ~18t~10,6g~34t~10,6g" + iter root (- root (sqrt 5.0d0)) (- root oldroot))))) diff --git a/sorting.lisp b/sorting.lisp index 6d5755c744ed0998eeb62fee13d8bf5456882378..89e666017e78e9b8f25a6d70c1ac649d9f8285e6 100644 --- a/sorting.lisp +++ b/sorting.lisp @@ -1,6 +1,6 @@ ;; Sorting ;; Liam Healy, Fri Apr 14 2006 - 20:20 -;; Time-stamp: <2008-12-07 18:43:39EST sorting.lisp> +;; Time-stamp: <2008-12-26 12:25:09EST sorting.lisp> ;; $Id$ (in-package :gsl) @@ -254,46 +254,46 @@ ;;;;**************************************************************************** (generate-all-array-tests sort-vector :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) ;; or you can use msort (cl-array (sort-vector v1)))) (generate-all-array-tests sort-matrix :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (cl-array (msort m1)))) (generate-all-array-tests sort-vector-index :no-complex - (letm ((perm (make-permutation 8)) + (let ((perm (make-permutation 8)) (v1 (array-default 8))) (sort-vector-index perm v1) (cl-array perm))) (generate-all-array-tests sort-vector-smallest :no-complex - (letm ((v1 (array-default 8)) + (let ((v1 (array-default 8)) (v2 (array-default 3))) (cl-array (sort-vector-smallest v2 v1)))) (generate-all-array-tests sort-matrix-smallest :no-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(2 3) t))) (cl-array (sort-smallest m2 m1)))) (generate-all-array-tests sort-vector-smallest-index :no-complex - (letm ((comb (make-combination '(8 3))) + (let ((comb (make-combination '(8 3))) (v1 (array-default 8))) (cl-array (sort-vector-smallest-index comb v1)))) (generate-all-array-tests sort-vector-largest :no-complex - (letm ((v1 (array-default 8)) + (let ((v1 (array-default 8)) (v2 (array-default 3))) (cl-array (sort-vector-largest v2 v1)))) (generate-all-array-tests sort-matrix-largest :no-complex - (letm ((m1 (array-default '(3 3))) + (let ((m1 (array-default '(3 3))) (m2 (array-default '(2 3) t))) (cl-array (sort-largest m2 m1)))) (generate-all-array-tests sort-vector-largest-index :no-complex - (letm ((comb (make-combination '(8 3))) + (let ((comb (make-combination '(8 3))) (v1 (array-default 8))) (cl-array (sort-vector-largest-index comb v1)))) diff --git a/special-functions/bessel.lisp b/special-functions/bessel.lisp index 0d1e36602d50e49f347edea320392c6c3713542c..f3bfe1bcffcfafb448aa69f8576c836eee6826b2 100644 --- a/special-functions/bessel.lisp +++ b/special-functions/bessel.lisp @@ -1,6 +1,6 @@ ;; Bessel functions ;; Liam Healy, Fri Mar 17 2006 - 18:42 -;; Time-stamp: <2008-12-26 10:28:24EST bessel.lisp> +;; Time-stamp: <2008-12-26 12:09:51EST bessel.lisp> ;; $Id$ (in-package :gsl) @@ -460,61 +460,61 @@ (cylindrical-bessel-J0 4.0d0) (cylindrical-bessel-J1 4.0d0) (cylindrical-bessel-Jn 2 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (cylindrical-bessel-Jn-array 2.0d0 besarr 2) (cl-array besarr)) (cylindrical-bessel-Y0 4.0d0) (cylindrical-bessel-Y1 4.0d0) (cylindrical-bessel-Yn 3 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (cylindrical-bessel-Yn-array 2.0d0 besarr 2) (cl-array besarr)) (cylindrical-bessel-I0 4.0d0) (cylindrical-bessel-I1 4.0d0) (cylindrical-bessel-In 3 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (cylindrical-bessel-In-array 2.0d0 besarr 2) (cl-array besarr)) (cylindrical-bessel-I0-scaled 4.0d0) (cylindrical-bessel-I1-scaled 4.0d0) (cylindrical-bessel-In-scaled 3 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (cylindrical-bessel-In-scaled-array 2.0d0 besarr 2) (cl-array besarr)) (cylindrical-bessel-K0 4.0d0) (cylindrical-bessel-K1 4.0d0) (cylindrical-bessel-Kn 2 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (cylindrical-bessel-Kn-array 2.0d0 besarr 2) (cl-array besarr)) (cylindrical-bessel-K0-scaled 4.0d0) (cylindrical-bessel-K1-scaled 4.0d0) (cylindrical-bessel-Kn-scaled 2 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (cylindrical-bessel-Kn-array 2.0d0 besarr 2) (cl-array besarr)) (spherical-bessel-j0 4.0d0) (spherical-bessel-j1 4.0d0) (spherical-bessel-j2 4.0d0) (spherical-bessel-jl 3 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (spherical-bessel-jl-array 4.0d0 besarr) (cl-array besarr)) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (spherical-bessel-jl-steed-array 4.0d0 besarr) (cl-array besarr)) (spherical-bessel-y0 4.0d0) (spherical-bessel-y1 4.0d0) (spherical-bessel-y2 4.0d0) (spherical-bessel-yl 2 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (spherical-bessel-yl-array 4.0d0 besarr) (cl-array besarr)) (spherical-bessel-i0-scaled 4.0d0) (spherical-bessel-i1-scaled 4.0d0) (spherical-bessel-i2-scaled 4.0d0) (spherical-bessel-il-scaled 3 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (spherical-bessel-il-scaled-array 4.0d0 besarr) (cl-array besarr)) (spherical-bessel-k0-scaled 4.0d0) @@ -522,11 +522,11 @@ (spherical-bessel-k2-scaled 4.0d0) (spherical-bessel-kl-scaled 3 4.0d0) - (letm ((besarr (make-marray 'double-float :dimensions 4))) + (let ((besarr (make-marray 'double-float :dimensions 4))) (spherical-bessel-kl-scaled-array 4.0d0 besarr) (cl-array besarr)) (bessel-jnu 3.0d0 4.0d0) - (letm ((besarr #m(1.0d0 2.0d0 3.0d0))) + (let ((besarr #m(1.0d0 2.0d0 3.0d0))) (spherical-Jnu-array 0.5d0 besarr) (cl-array besarr)) (bessel-Ynu 3.0d0 4.0d0) diff --git a/special-functions/coulomb.lisp b/special-functions/coulomb.lisp index c165f5be9d295d4de3685bac91a1609cbf22bcf9..ae95a9bd78d052e72f4d9caa049b327d6bd09901 100644 --- a/special-functions/coulomb.lisp +++ b/special-functions/coulomb.lisp @@ -1,6 +1,6 @@ ;; Coulumb functions ;; Liam Healy, Sat Mar 18 2006 - 23:23 -;; Time-stamp: <2008-12-26 10:28:23EST coulomb.lisp> +;; Time-stamp: <2008-12-26 12:18:56EST coulomb.lisp> ;; $Id$ (in-package :gsl) @@ -125,19 +125,19 @@ ;;;;**************************************************************************** (save-test coulomb - (hydrogenicr-1 1.0d0 2.5d0) - (hydrogenicr 3 1 1.0d0 2.5d0) - (coulomb-wave-FG 0.0d0 1.0d0 2.0d0 0) - (letm ((arr (make-marray 'double-float :dimensions 3))) - (coulomb-wave-F-array 0.0d0 1.0d0 2.0d0 arr) - (cl-array arr)) - (coulomb-wave-fg 1.0d0 2.0d0 2.5d0 1) - (letm ((Farr (make-marray 'double-float :dimensions 3)) - (Garr (make-marray 'double-float :dimensions 3))) - (coulomb-wave-FG-array 1.5d0 1.0d0 1.0d0 Farr Garr) - (append (coerce (cl-array Farr) 'list) (coerce (cl-array Garr) 'list))) - (letm ((arr (make-marray 'double-float :dimensions 3))) - (coulomb-wave-sphF-array 0.0d0 1.0d0 2.0d0 arr) (cl-array arr)) - (coulomb-cl 1.0d0 2.5d0) - (letm ((cl (make-marray 'double-float :dimensions 3))) - (coulomb-CL-array 0.0d0 1.0d0 cl) (cl-array cl))) + (hydrogenicr-1 1.0d0 2.5d0) + (hydrogenicr 3 1 1.0d0 2.5d0) + (coulomb-wave-FG 0.0d0 1.0d0 2.0d0 0) + (let ((arr (make-marray 'double-float :dimensions 3))) + (coulomb-wave-F-array 0.0d0 1.0d0 2.0d0 arr) + (cl-array arr)) + (coulomb-wave-fg 1.0d0 2.0d0 2.5d0 1) + (let ((Farr (make-marray 'double-float :dimensions 3)) + (Garr (make-marray 'double-float :dimensions 3))) + (coulomb-wave-FG-array 1.5d0 1.0d0 1.0d0 Farr Garr) + (append (coerce (cl-array Farr) 'list) (coerce (cl-array Garr) 'list))) + (let ((arr (make-marray 'double-float :dimensions 3))) + (coulomb-wave-sphF-array 0.0d0 1.0d0 2.0d0 arr) (cl-array arr)) + (coulomb-cl 1.0d0 2.5d0) + (let ((cl (make-marray 'double-float :dimensions 3))) + (coulomb-CL-array 0.0d0 1.0d0 cl) (cl-array cl))) diff --git a/special-functions/gegenbauer.lisp b/special-functions/gegenbauer.lisp index 44697fb3f24d7dda5f4c3339c23c70ca290184df..be2c6d122a74a480f4cdadf7b3568b27ab97b57a 100644 --- a/special-functions/gegenbauer.lisp +++ b/special-functions/gegenbauer.lisp @@ -1,6 +1,6 @@ ;; Gegenbauer polynomials ;; Liam Healy, Fri Apr 28 2006 - 20:40 -;; Time-stamp: <2008-12-26 10:28:24EST gegenbauer.lisp> +;; Time-stamp: <2008-12-26 12:25:31EST gegenbauer.lisp> ;; $Id$ (in-package :gsl) @@ -48,5 +48,5 @@ (gegenbauer-2 1.0d0 3.0d0) (gegenbauer-3 1.0d0 3.0d0) (gegenbauer 4 1.0d0 3.0d0) - (letm ((arr (make-marray 'double-float :dimensions 4))) + (let ((arr (make-marray 'double-float :dimensions 4))) (gegenbauer-array 1.0d0 3.0d0 arr) (cl-array arr))) diff --git a/special-functions/legendre.lisp b/special-functions/legendre.lisp index 23802cb5de0476719abae8e660ba59352cd5162e..9da1514611bf193951410d114bc2f4637ee73026 100644 --- a/special-functions/legendre.lisp +++ b/special-functions/legendre.lisp @@ -1,6 +1,6 @@ ;; Legendre functions ;; Liam Healy, Sat Apr 29 2006 - 19:16 -;; Time-stamp: <2008-12-26 10:28:23EST legendre.lisp> +;; Time-stamp: <2008-12-26 11:52:33EST legendre.lisp> ;; $Id$ (in-package :gsl) @@ -258,25 +258,25 @@ (legendre-Pl -4 0.3d0) (legendre-Pl 4 3.0d0) (legendre-Pl 4 0.3d0) - (letm ((arr (make-marray 'double-float :dimensions 4))) + (let ((arr (make-marray 'double-float :dimensions 4))) (legendre-Pl-array 0.5d0 arr) (cl-array arr)) (legendre-Q0 3.3d0) (legendre-Q1 3.3d0) (legendre-Ql 2 3.3d0) (legendre-Plm 4 3 0.5d0) - (letm ((arr (make-marray 'double-float :dimensions 4))) + (let ((arr (make-marray 'double-float :dimensions 4))) (legendre-Plm-array 2 0.5d0 arr) (cl-array arr)) - (letm ((val (make-marray 'double-float :dimensions 4)) - (deriv (make-marray 'double-float :dimensions 4))) + (let ((val (make-marray 'double-float :dimensions 4)) + (deriv (make-marray 'double-float :dimensions 4))) (legendre-Plm-deriv-array 2 0.5d0 val deriv) (cl-array deriv)) (legendre-sphplm 1200 1100 0.3d0) - (letm ((arr (make-marray 'double-float :dimensions 4))) + (let ((arr (make-marray 'double-float :dimensions 4))) (legendre-sphPlm-array 4 0.5d0 arr) (cl-array arr)) - (letm ((val (make-marray 'double-float :dimensions 4)) + (let ((val (make-marray 'double-float :dimensions 4)) (deriv (make-marray 'double-float :dimensions 4))) (legendre-sphPlm-deriv-array 4 0.5d0 val deriv) (cl-array deriv)) @@ -289,7 +289,6 @@ (legendre-h3d-0 1.0d0 0.5d0) (legendre-h3d-1 1.0d0 0.5d0) (legendre-h3d 4 1.0d0 0.5d0) - (letm ((arr (make-marray 'double-float :dimensions 4))) + (let ((arr (make-marray 'double-float :dimensions 4))) (legendre-h3d-array 1.0d0 0.5d0 arr) (cl-array arr))) - diff --git a/statistics/absolute-deviation.lisp b/statistics/absolute-deviation.lisp index 485c02f6c2c1d2d2266df4810bdbe06cd7836ff8..bd1a5366ec602c7bd386c921e451cb30880d8799 100644 --- a/statistics/absolute-deviation.lisp +++ b/statistics/absolute-deviation.lisp @@ -1,6 +1,6 @@ ;; Absolute deviation ;; Liam Healy, Sun Dec 31 2006 - 13:19 -;; Time-stamp: <2008-12-07 18:44:47EST absolute-deviation.lisp> +;; Time-stamp: <2008-12-26 12:20:09EST absolute-deviation.lisp> ;; $Id$ (in-package :gsl) @@ -51,7 +51,7 @@ ;;; Examples and unit test (save-test absolute-deviation - (letm ((vec #m(-3.21d0 1.0d0 12.8d0)) + (let ((vec #m(-3.21d0 1.0d0 12.8d0)) (weights #m(3.0d0 1.0d0 2.0d0))) (let ((mean (mean vec))) (list diff --git a/statistics/autocorrelation.lisp b/statistics/autocorrelation.lisp index cc384b6e446cc4a8e7d6de34d811bf4d92e1e38f..b1f15c65019a65aae287026752f775bfe70fb174 100644 --- a/statistics/autocorrelation.lisp +++ b/statistics/autocorrelation.lisp @@ -1,6 +1,6 @@ ;; Autocorrelation ;; Liam Healy, Sun Dec 31 2006 - 13:19 -;; Time-stamp: <2008-12-07 18:45:02EST autocorrelation.lisp> +;; Time-stamp: <2008-12-26 12:20:10EST autocorrelation.lisp> ;; $Id$ (in-package :gsl) @@ -27,7 +27,7 @@ ;;; Examples and unit test (save-test autocorrelation - (letm ((vec #m(-3.21d0 1.0d0 12.8d0))) + (let ((vec #m(-3.21d0 1.0d0 12.8d0))) (let ((mean (mean vec))) (list (autocorrelation vec) diff --git a/statistics/covariance.lisp b/statistics/covariance.lisp index a79b20513484162e70d0b53fab3ba5383774e06f..e472e847a8f457fb6d41bd505418a5a4e34e7f69 100644 --- a/statistics/covariance.lisp +++ b/statistics/covariance.lisp @@ -1,6 +1,6 @@ ;; Covariance ;; Liam Healy, Sun Dec 31 2006 - 13:19 -;; Time-stamp: <2008-12-07 18:45:21EST covariance.lisp> +;; Time-stamp: <2008-12-26 12:19:23EST covariance.lisp> ;; $Id$ (in-package :gsl) @@ -30,7 +30,7 @@ ;;; Examples and unit test (save-test covariance - (letm ((vec1 #m(-3.21d0 1.0d0 12.8d0)) + (let ((vec1 #m(-3.21d0 1.0d0 12.8d0)) (vec2 #m(1.15d0 -1.0d0 0.5d0))) (let ((mean1 (mean vec1)) (mean2 (mean vec2))) diff --git a/statistics/higher-moments.lisp b/statistics/higher-moments.lisp index cb17d21f31c08ec19ae5cc1a0cde909980774c2f..e1d7bd1ff8a2dce09422a20b6e09f7aee5cab42a 100644 --- a/statistics/higher-moments.lisp +++ b/statistics/higher-moments.lisp @@ -1,6 +1,6 @@ ;; Skewness and kurtosis. ;; Liam Healy, Sun Dec 31 2006 - 14:20 -;; Time-stamp: <2008-12-07 18:46:13EST higher-moments.lisp> +;; Time-stamp: <2008-12-26 12:20:08EST higher-moments.lisp> ;; $Id$ (in-package :gsl) @@ -85,7 +85,7 @@ ;;; Examples and unit test (save-test higher-moments - (letm ((vec #m(-3.21d0 1.0d0 12.8d0))) + (let ((vec #m(-3.21d0 1.0d0 12.8d0))) (let* ((mean (mean vec)) (sd (standard-deviation vec mean))) (list diff --git a/statistics/mean-variance.lisp b/statistics/mean-variance.lisp index 7e81b9ca235ea3d31274ad552b3766bd47565554..3e5db4d6ab0b4d38e67f1b823e1c2b0c63881650 100644 --- a/statistics/mean-variance.lisp +++ b/statistics/mean-variance.lisp @@ -1,6 +1,6 @@ ;; Mean, standard deviation, and variance ;; Liam Healy, Sat Dec 2 2006 - 22:15 -;; Time-stamp: <2008-12-07 19:13:40EST mean-variance.lisp> +;; Time-stamp: <2008-12-26 12:21:30EST mean-variance.lisp> ;; $Id$ (in-package :gsl) @@ -197,66 +197,66 @@ ;;;;**************************************************************************** (generate-all-array-tests vector-mean :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (mean v1))) (generate-all-array-tests matrix-mean :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (mean m1))) (generate-all-array-tests vector-variance :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (variance v1))) (generate-all-array-tests matrix-variance :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (variance m1))) (generate-all-array-tests vector-variance-with-mean :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (variance v1 (mean v1)))) (generate-all-array-tests matrix-variance-with-mean :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (variance m1 (mean m1)))) (generate-all-array-tests vector-standard-deviation :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (standard-deviation v1))) (generate-all-array-tests matrix-standard-deviation :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (standard-deviation m1))) (generate-all-array-tests vector-standard-deviation-with-mean :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (standard-deviation v1 (mean v1)))) (generate-all-array-tests matrix-standard-deviation-with-mean :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (standard-deviation m1 (mean m1)))) (generate-all-array-tests vector-variance-with-fixed-mean :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (variance-with-fixed-mean v1 (mean v1)))) (generate-all-array-tests matrix-variance-with-fixed-mean :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (variance-with-fixed-mean m1 (mean m1)))) (generate-all-array-tests vector-standard-deviation-with-fixed-mean :no-complex - (letm ((v1 (array-default 8))) + (let ((v1 (array-default 8))) (standard-deviation-with-fixed-mean v1 (mean v1)))) (generate-all-array-tests matrix-standard-deviation-with-fixed-mean :no-complex - (letm ((m1 (array-default '(3 3)))) + (let ((m1 (array-default '(3 3)))) (standard-deviation-with-fixed-mean m1 (mean m1)))) #| ;;; Weighted mean seems to be in error in GSL ;;; Hold off on all weghted tests until this is resolved. (generate-all-array-tests weighted-mean :float - (letm ((v1 (array-default 8)) + (let ((v1 (array-default 8)) (v2 (array-default 8))) (loop for i below (first (dimensions v2)) do (setf (maref v2 i) (abs (maref v2 i)))) diff --git a/statistics/median-percentile.lisp b/statistics/median-percentile.lisp index 8d4644ad4ba169cc36c9f676cd23f41bf2f687f6..2c73b7a90ebc77947fdea28e49046a706e609367 100644 --- a/statistics/median-percentile.lisp +++ b/statistics/median-percentile.lisp @@ -1,6 +1,6 @@ ;; Median and percentile ;; Liam Healy, Sun Dec 31 2006 - 13:19 -;; Time-stamp: <2008-12-07 18:48:02EST median-percentile.lisp> +;; Time-stamp: <2008-12-26 12:20:11EST median-percentile.lisp> ;; $Id$ (in-package :gsl) @@ -55,7 +55,7 @@ ;;; Examples and unit test (save-test median-percentile - (letm ((vec #m(-3.21d0 1.0d0 12.8d0))) + (let ((vec #m(-3.21d0 1.0d0 12.8d0))) (median vec)) - (letm ((vec #m(-18.0d0 -12.0d0 -3.21d0 0.5d0 1.0d0 2.7d0 12.8d0))) + (let ((vec #m(-18.0d0 -12.0d0 -3.21d0 0.5d0 1.0d0 2.7d0 12.8d0))) (quantile vec 0.75d0))) diff --git a/wavelet.lisp b/wavelet.lisp index 813e76809942fc0997ff5ff2f1aa3faffd3a5aa6..4fc0a88eccac3ec507abb9428cda52fef7315927 100644 --- a/wavelet.lisp +++ b/wavelet.lisp @@ -1,6 +1,6 @@ ;; Wavelet transforms. ;; Liam Healy, Mon Nov 26 2007 - 20:43 -;; Time-stamp: <2008-12-26 10:28:22EST wavelet.lisp> +;; Time-stamp: <2008-12-26 13:16:29EST wavelet.lisp> ;; $Id$ (in-package :gsl) @@ -20,7 +20,6 @@ ;;;; Allocation of wavelets ;;;;**************************************************************************** -#| (defmobject wavelet "gsl_wavelet" ((type :pointer) (member sizet)) "wavelet" ; FDL @@ -28,30 +27,6 @@ parameter 'member selects the specific member of the wavelet family. A memory-allocation-failure error indicates either lack of memory or an unsupported member requested.") -|# - -(defgo-s (wavelet type member) allocate-wavelet free-wavelet nil 2) - -(defmfun allocate-wavelet (type member) - "gsl_wavelet_alloc" - ((type :pointer) (member sizet)) - :c-return :pointer - :export nil - :index (letm wavelet) - :documentation ; FDL - "Allocate and initialize a wavelet object of type 'type. The - parameter 'member selects the specific member of the wavelet - family. A memory-allocation-failure error indicates either - lack of memory or an unsupported member requested.") - -(defmfun free-wavelet (wavelet) - "gsl_wavelet_free" - ((wavelet :pointer)) - :c-return :void - :export nil - :index (letm wavelet) - :documentation ; FDL - "Free the wavelet object.") (defmpar *daubechies-wavelet* "gsl_wavelet_daubechies" ;; FDL @@ -94,7 +69,6 @@ :documentation ; FDL "The name of the wavelet family.") -#| (defmobject wavelet-workspace "gsl_wavelet_workspace" ((size sizet)) @@ -105,32 +79,6 @@ size-by-size matrices it is sufficient to allocate a workspace of size, since the transform operates on individual rows and columns.") -|# - -(defgo-s (wavelet-workspace size) allocate-wavelet-workspace free-wavelet-workspace) - -(defmfun allocate-wavelet-workspace (size) - "gsl_wavelet_workspace_alloc" - ((size sizet)) - :c-return :pointer - :export nil - :index (letm wavelet-workspace) - :documentation ; FDL - "Allocate a workspace for the discrete wavelet transform. - To perform a one-dimensional transform on size elements, a workspace - of size size must be provided. For two-dimensional transforms of - size-by-size matrices it is sufficient to allocate a workspace of - size, since the transform operates on individual rows and - columns.") - -(defmfun free-wavelet-workspace (workspace) - "gsl_wavelet_workspace_free" - ((workspace :pointer)) - :c-return :void - :export nil - :index (letm wavelet-workspace) - :documentation ; FDL - "Free the allocated workspace.") ;;;;**************************************************************************** ;;;; Wavelet transforms 1D @@ -409,13 +357,13 @@ functions. It computes an approximation to an input signal (of length 256) using the 20 largest components of the wavelet transform, while setting the others to zero. See GSL manual Section 30.4." - (letm ((n (length cl-data)) + (let* ((n (length cl-data)) (vector cl-data) - (wavelet (wavelet *daubechies-wavelet* 4)) - (workspace (wavelet-workspace n))) + (wavelet (make-wavelet *daubechies-wavelet* 4)) + (workspace (make-wavelet-workspace n))) (wavelet-transform-forward wavelet vector 1 workspace) - (letm ((absvector (make-marray 'double-float :dimensions n)) - (permutation (make-permutation n))) + (let ((absvector (make-marray 'double-float :dimensions n)) + (permutation (make-permutation n))) (dotimes (i n) (setf (maref absvector i) (abs (maref vector i)))) ;; Sort and set to 0 all but the largest 20. @@ -429,9 +377,9 @@ (defun wavelet-forward-example (&optional (cl-data *wavelet-sample*)) "Simpler example, with only a Daubechies wavelet forward transformation." - (letm ((n (length cl-data)) + (let* ((n (length cl-data)) (vector cl-data) - (wavelet (wavelet *daubechies-wavelet* 4)) - (workspace (wavelet-workspace n))) + (wavelet (make-wavelet *daubechies-wavelet* 4)) + (workspace (make-wavelet-workspace n))) (wavelet-transform-forward wavelet vector 1 workspace) (cl-array vector)))