Commit 0343f3ce authored by Liam Healy's avatar Liam Healy

Port tests to save-test

All remaning tests are now defined with save-test, and the
LISP-UNIT:DEFINE-TEST has been eliminated from the definition files,
except for arrays.
parent 0fb0effc
;; Chebyshev Approximations ;; Chebyshev Approximations
;; Liam Healy Sat Nov 17 2007 - 20:36 ;; Liam Healy Sat Nov 17 2007 - 20:36
;; Time-stamp: <2008-08-23 11:27:10EDT chebyshev.lisp> ;; Time-stamp: <2008-10-25 11:33:06EDT chebyshev.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -123,16 +123,6 @@ ...@@ -123,16 +123,6 @@
(evaluate-chebyshev deriv x) (evaluate-chebyshev deriv x)
(evaluate-chebyshev integ x)))) (evaluate-chebyshev integ x))))
;;; Unit test
#| (save-test chebyshev
(make-tests chebyshev
(chebyshev-point-example 0.55d0)) (chebyshev-point-example 0.55d0))
|#
(LISP-UNIT:DEFINE-TEST CHEBYSHEV
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
(LIST 0.7159209901689866d0 -1.5019966658054353d0
0.17239719403979925d0))
(MULTIPLE-VALUE-LIST (CHEBYSHEV-POINT-EXAMPLE 0.55d0))))
;; Combinations ;; Combinations
;; Liam Healy, Sun Mar 26 2006 - 11:51 ;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2008-09-20 22:04:48EDT combination.lisp> ;; Time-stamp: <2008-10-25 19:05:36EDT combination.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -172,8 +172,7 @@ ...@@ -172,8 +172,7 @@
;;;; Examples and unit test ;;;; Examples and unit test
;;;;**************************************************************************** ;;;;****************************************************************************
#| (save-test combination
(make-tests combination
(letm ((comb (combination '(4 2) t))) ; combination-range (letm ((comb (combination '(4 2) t))) ; combination-range
(combination-range comb)) (combination-range comb))
(letm ((comb (combination '(4 2) t))) ; combination-size (letm ((comb (combination '(4 2) t))) ; combination-size
...@@ -192,42 +191,3 @@ ...@@ -192,42 +191,3 @@
(init-first comb) (init-first comb)
(loop collect (copy-seq (cl-array comb)) (loop collect (copy-seq (cl-array comb))
while (combination-next comb))))) while (combination-next comb)))))
|#
(LISP-UNIT:DEFINE-TEST COMBINATION
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 4)
(MULTIPLE-VALUE-LIST
(LETM ((COMB (COMBINATION '(4 2) T)))
(COMBINATION-RANGE COMB))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2)
(MULTIPLE-VALUE-LIST
(LETM ((COMB (COMBINATION '(4 2) T)))
(COMBINATION-SIZE COMB))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST (LIST #(0 1) #(0 2) #(0 3) #(1 2) #(1 3) #(2 3)))
(MULTIPLE-VALUE-LIST
(LETM ((COMB (COMBINATION '(4 2) T)))
(INIT-FIRST COMB)
(LOOP COLLECT (COPY-SEQ (CL-ARRAY COMB)) WHILE
(COMBINATION-NEXT COMB)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST (LIST #(2 3) #(1 3) #(1 2) #(0 3) #(0 2) #(0 1)))
(MULTIPLE-VALUE-LIST
(LETM ((COMB (COMBINATION '(4 2) T))) (INIT-LAST COMB)
(LOOP COLLECT (COPY-SEQ (CL-ARRAY COMB)) WHILE
(COMBINATION-PREVIOUS COMB)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
(LIST #() #(0) #(1) #(2) #(3) #(0 1) #(0 2) #(0 3)
#(1 2) #(1 3) #(2 3) #(0 1 2) #(0 1 3) #(0 2 3)
#(1 2 3) #(0 1 2 3)))
(MULTIPLE-VALUE-LIST
(LOOP FOR I FROM 0 TO 4 APPEND
(LETM ((COMB (COMBINATION (LIST 4 I) T)))
(INIT-FIRST COMB)
(LOOP COLLECT (COPY-SEQ (CL-ARRAY COMB))
WHILE (COMBINATION-NEXT COMB)))))))
;; Permutations ;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51 ;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2008-09-20 21:59:49EDT permutation.lisp> ;; Time-stamp: <2008-10-25 18:52:27EDT permutation.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -263,8 +263,7 @@ ...@@ -263,8 +263,7 @@
(loop collect (copy-seq (cl-array perm)) (loop collect (copy-seq (cl-array perm))
while (permutation-previous perm)))) while (permutation-previous perm))))
#| (save-test
(make-tests
permutation permutation
(letm ((perm-1 (permutation 4 t))) ;maref (letm ((perm-1 (permutation 4 t))) ;maref
(set-identity perm-1) (set-identity perm-1)
...@@ -307,77 +306,3 @@ ...@@ -307,77 +306,3 @@
(swap-elements perm-1 1 3) (swap-elements perm-1 1 3)
(swap-elements perm-1 0 2) (swap-elements perm-1 0 2)
(canonical-cycles perm-1))) (canonical-cycles perm-1)))
|#
(LISP-UNIT:DEFINE-TEST PERMUTATION
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2)
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(MAREF PERM-1 2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(0 1 2 3))
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(CL-ARRAY PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(3 2 1 0))
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T)))
(SET-IDENTITY
PERM-1)
(CL-ARRAY (PERMUTATION-REVERSE PERM-1)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(0 3 1 2))
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T))
(PERM-2 (PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(PERMUTATION-NEXT PERM-1)
(PERMUTATION-NEXT PERM-1)
(PERMUTATION-NEXT PERM-1)
(PERMUTATION-INVERSE PERM-2 PERM-1)
(CL-ARRAY PERM-2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(0 3 2 1))
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(CL-ARRAY PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(33 44 11 22))
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T))
(INTVEC (VECTOR-SIGNED-BYTE-32
(A 11 22 33 44))))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(SWAP-ELEMENTS PERM-1 0 2)
(PERMUTE-VECTOR PERM-1 INTVEC)
(CL-ARRAY INTVEC))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 3)
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(INVERSIONS PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 3)
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(LINEAR-CYCLES PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2)
(MULTIPLE-VALUE-LIST
(LETM ((PERM-1 (PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(SWAP-ELEMENTS PERM-1 0 2)
(CANONICAL-CYCLES PERM-1)))))
...@@ -39,10 +39,11 @@ to find that the Lisp function name is <code>#'jacobian-elliptic-functions</code ...@@ -39,10 +39,11 @@ to find that the Lisp function name is <code>#'jacobian-elliptic-functions</code
</pre> </pre>
to get an explanation of the arguments etc. to get an explanation of the arguments etc.
</li> </li>
<li>Look at the end of the Lisp source file, or in an "example" file <li>Use the function <code>(examples)</code> to get a list of example
in the same directory, for examples. Often, the examples are placed categories. Then use the function with a category name as the
in a <code>make-tests</code> form (which will be commented out with argument to get a list of examples under that category, for
a #| |# block). If the example
<code>(examples 'higher-moments)</code>. If the
<a href="http://www.gnu.org/software/gsl/manual/">GSL documentation</a> <a href="http://www.gnu.org/software/gsl/manual/">GSL documentation</a>
provides an example, there will usually be the same or similar provides an example, there will usually be the same or similar
example provided in GSLL.</li> example provided in GSLL.</li>
...@@ -200,7 +201,7 @@ gamma-randist, negative-binomial. ...@@ -200,7 +201,7 @@ gamma-randist, negative-binomial.
<address><a href="mailto:gsll-devel@common-lisp.net">Liam Healy</a></address> <address><a href="mailto:gsll-devel@common-lisp.net">Liam Healy</a></address>
<!-- hhmts start --> <!-- hhmts start -->
<small> <small>
Time-stamp: <2008-09-21 15:37:13EDT documentation.html> Time-stamp: <2008-10-25 18:59:39EDT documentation.html>
</small> </small>
<!-- hhmts end --> <!-- hhmts end -->
</div> </div>
......
;; Eigenvectors and eigenvalues ;; Eigenvectors and eigenvalues
;; Liam Healy, Sun May 21 2006 - 19:52 ;; Liam Healy, Sun May 21 2006 - 19:52
;; Time-stamp: <2008-08-14 22:48:02EDT eigensystems.lisp> ;; Time-stamp: <2008-10-25 11:34:13EDT eigensystems.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -168,17 +168,6 @@ ...@@ -168,17 +168,6 @@
(eigenvalues-eigenvectors mat evals evecs ws) (eigenvalues-eigenvectors mat evals evecs ws)
(values (cl-array evals) (cl-array evecs)))) (values (cl-array evals) (cl-array evecs))))
#| (save-test eigensystems
(make-tests eigensystems (eigenvalue-eigenvectors-example))
(eigenvalue-eigenvectors-example))
|#
(LISP-UNIT:DEFINE-TEST EIGENSYSTEMS
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#(13.819660112501051d0 36.180339887498945d0 40.0d0)
#2A((0.8506508083520399d0 -0.5257311121191337d0 0.0d0)
(0.5257311121191337d0 0.8506508083520399d0 0.0d0)
(0.0d0 0.0d0 1.0d0)))
(MULTIPLE-VALUE-LIST
(EIGENVALUE-EIGENVECTORS-EXAMPLE))))
;; Updating and accessing histogram elements. ;; Updating and accessing histogram elements.
;; Liam Healy, Mon Jan 1 2007 - 14:43 ;; Liam Healy, Mon Jan 1 2007 - 14:43
;; Time-stamp: <2008-09-14 22:04:40EDT updating-accessing.lisp> ;; Time-stamp: <2008-10-25 18:24:41EDT updating-accessing.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -99,8 +99,7 @@ ...@@ -99,8 +99,7 @@
|# |#
;;; Examples and unit test ;;; Examples and unit test
#| (save-test histogram
(make-tests histogram
;; The first one gives a warning while compiling in SBCL, ;; The first one gives a warning while compiling in SBCL,
;; should only give a warning while runnin. ;; should only give a warning while runnin.
(letm ((histo (histogram 10))) (letm ((histo (histogram 10)))
...@@ -141,67 +140,3 @@ ...@@ -141,67 +140,3 @@
(increment histo 2.7d0) (increment histo 2.7d0)
(increment histo 6.9d0 2.0d0) (increment histo 6.9d0 2.0d0)
(histogram-find histo 5.5d0))) (histogram-find histo 5.5d0)))
|#
(LISP-UNIT:DEFINE-TEST HISTOGRAM
(LISP-UNIT:ASSERT-ERROR
'GSL-CONDITION
(LETM ((HISTO (HISTOGRAM 10)))
(SET-RANGES-UNIFORM HISTO 0.0d0 10.0d0)
(INCREMENT HISTO -2.0d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.0d0)
(MULTIPLE-VALUE-LIST
(LETM ((HISTO (HISTOGRAM 10)))
(SET-RANGES-UNIFORM HISTO 0.0d0 10.0d0)
(INCREMENT HISTO 2.7d0)
(INCREMENT HISTO 6.9d0 2.0d0)
(MAREF HISTO 1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0)
(MULTIPLE-VALUE-LIST
(LETM ((HISTO (HISTOGRAM 10)))
(SET-RANGES-UNIFORM HISTO 0.0d0 10.0d0)
(INCREMENT HISTO 2.7d0)
(INCREMENT HISTO 6.9d0 2.0d0)
(MAREF HISTO 2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2.0d0)
(MULTIPLE-VALUE-LIST
(LETM ((HISTO (HISTOGRAM 10)))
(SET-RANGES-UNIFORM HISTO 0.0d0 10.0d0)
(INCREMENT HISTO 2.7d0)
(INCREMENT HISTO 6.9d0 2.0d0)
(MAREF HISTO 6))))
(LISP-UNIT:ASSERT-ERROR
'GSL-CONDITION
(LETM ((HISTO (HISTOGRAM 10)))
(SET-RANGES-UNIFORM HISTO 0.0d0 10.0d0)
(INCREMENT HISTO 2.7d0)
(INCREMENT HISTO 6.9d0 2.0d0)
(MAREF HISTO 16)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.0d0 10.0d0)
(MULTIPLE-VALUE-LIST
(LETM ((HISTO (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)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 10)
(MULTIPLE-VALUE-LIST
(LETM ((HISTO (HISTOGRAM 10)))
(SET-RANGES-UNIFORM HISTO 0.0d0 10.0d0)
(INCREMENT HISTO 2.7d0)
(INCREMENT HISTO 6.9d0 2.0d0)
(BINS HISTO))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 5)
(MULTIPLE-VALUE-LIST
(LETM ((HISTO (HISTOGRAM 10)))
(SET-RANGES-UNIFORM HISTO 0.0d0 10.0d0)
(INCREMENT HISTO 2.7d0)
(INCREMENT HISTO 6.9d0 2.0d0)
(HISTOGRAM-FIND HISTO 5.5d0)))))
;; Make tests and examples ;; Make tests and examples
;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
;; Time-stamp: <2008-10-21 22:40:41EDT generate-tests.lisp> ;; Time-stamp: <2008-10-25 19:06:40EDT generate-tests.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :gsl)
(export 'examples)
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Data pool ;;;; Data pool
;;;;**************************************************************************** ;;;;****************************************************************************
...@@ -26,12 +28,8 @@ ...@@ -26,12 +28,8 @@
,(numerical-serialize vals) ,(numerical-serialize vals)
(multiple-value-list ,form))))) (multiple-value-list ,form)))))
(defmacro make-tests (name &rest forms)
(append
`(lisp-unit:define-test ,name)
(mapcar #'make-test forms)))
(defparameter *all-generated-tests* nil) (defparameter *all-generated-tests* nil)
(defmacro save-test (name &rest forms) (defmacro save-test (name &rest forms)
"Save the test with the given name." "Save the test with the given name."
`(setf `(setf
...@@ -42,6 +40,15 @@ ...@@ -42,6 +40,15 @@
(getf *all-generated-tests* ',name)) (getf *all-generated-tests* ',name))
:test #'equal))) :test #'equal)))
(defun examples (&optional name)
"If no argument is supplied, list the names of the example categories.
If a category name is given as the argument, give the list of examples
in that category."
(if name
(getf *all-generated-tests* name)
(loop for (key value) on *all-generated-tests* by #'cddr
collect key)))
(defun create-test (test-name) (defun create-test (test-name)
"Find the saved test by name and create it, with the generated results." "Find the saved test by name and create it, with the generated results."
(append (append
...@@ -86,10 +93,6 @@ ...@@ -86,10 +93,6 @@
(format t "Writing test ~a to file~&" test-name) (format t "Writing test ~a to file~&" test-name)
(format stream "~s~%~%" (create-test test-name))))) (format stream "~s~%~%" (create-test test-name)))))
(defmacro make-tests (name &rest forms)
(append
`(lisp-unit:define-test ,name)
(mapcar #'make-test forms)))
|# |#
;;;;**************************************************************************** ;;;;****************************************************************************
......
;; BLAS level 1, Vector operations ;; BLAS level 1, Vector operations
;; Liam Healy, Wed Apr 26 2006 - 15:23 ;; Liam Healy, Wed Apr 26 2006 - 15:23
;; Time-stamp: <2008-08-31 15:12:31EDT blas1.lisp> ;; Time-stamp: <2008-10-25 18:41:45EDT blas1.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -182,67 +182,58 @@ ...@@ -182,67 +182,58 @@
;;;;**************************************************************************** ;;;;****************************************************************************
#| #|
;;; Before expanding, set (save-test blas1-single
;;; (setf *read-default-float-format* 'double-float)
(make-tests blas1-single
;; single ;; single
(letm ((a (vector-single-float #(1.0f0 2.0f0 3.0f0))) (letm ((a (vector-single-float (a 1.0f0 2.0f0 3.0f0)))
(b (vector-single-float #(3.0f0 4.0f0 5.0f0)))) (b (vector-single-float (a 3.0f0 4.0f0 5.0f0))))
(dot a b)) (dot a b))
(letm ((b (vector-single-float #(3.0f0 4.0f0 5.0f0)))) (letm ((b (vector-single-float (a 3.0f0 4.0f0 5.0f0))))
(euclidean-norm b)) (euclidean-norm b))
(letm ((b (vector-single-float #(3.0f0 4.0f0 5.0f0)))) (letm ((b (vector-single-float (a 3.0f0 4.0f0 5.0f0))))
(asum b)) (absolute-sum b))
(letm ((b (vector-single-float #(3.0f0 5.0f0 4.0f0)))) (letm ((b (vector-single-float (a 3.0f0 5.0f0 4.0f0))))
(imax b)) (index-max b))
(letm ((a (vector-single-float #(1.0f0 2.0f0 3.0f0))) (letm ((a (vector-single-float (a 1.0f0 2.0f0 3.0f0)))
(b (vector-single-float #(3.0f0 4.0f0 5.0f0)))) (b (vector-single-float (a 3.0f0 4.0f0 5.0f0))))
(setf (data a) #(1.0f0 2.0f0 3.0f0) (axpy 2.0f0 a b)
(data b) #(3.0f0 4.0f0 5.0f0)) (cl-array b))
(axpy 2.0f0 a b) (letm ((b (vector-single-float (a 3.0f0 4.0f0 5.0f0))))
(data b)) (scale 2.0f0 b)
(letm ((b (vector-single-float #(3.0f0 4.0f0 5.0f0)))) (cl-array b))
(setf (data b) #(3.0f0 4.0f0 5.0f0))
(scal 2.0f0 b)
(data b))
(letm ((a (vector-single-float #(1.0f0 3.0f0))) (letm ((a (vector-single-float #(1.0f0 3.0f0)))
(b (vector-single-float #(8.0f0 9.0f0)))) (b (vector-single-float #(8.0f0 9.0f0))))
(rot a b (/ (sqrt 2.0f0)) (/ (sqrt 2.0f0))) (givens-rotation a b (/ (sqrt 2.0f0)) (/ (sqrt 2.0f0)))
(data b))) (cl-array b)))
;;; Before expanding, set (save-test blas1-double
;;; (setf *read-default-float-format* 'single-float) (letm ((a (vector-double-float (a 1.0d0 2.0d0 3.0d0)))
(make-tests blas1-double (b (vector-double-float (a 3.0d0 4.0d0 5.0d0))))
(letm ((a (vector-double-float #(1.0d0 2.0d0 3.0d0)))
(b (vector-double-float #(3.0d0 4.0d0 5.0d0))))
(dot a b)) (dot a b))
(letm ((b (vector-double-float #(3.0d0 4.0d0 5.0d0)))) (letm ((b (vector-double-float (a 3.0d0 4.0d0 5.0d0))))
(euclidean-norm b)) (euclidean-norm b))
(letm ((b (vector-double-float #(3.0d0 4.0d0 5.0d0)))) (letm ((b (vector-double-float (a 3.0d0 4.0d0 5.0d0))))
(setf (data b) #(3.0d0 4.0d0 5.0d0)) (absolute-sum b))
(asum b)) (letm ((b (vector-double-float (a 3.0d0 5.0d0 4.0d0))))
(letm ((b (vector-double-float #(3.0d0 5.0d0 4.0d0)))) (index-max b))
(setf (data b) #(3.0d0 5.0d0 4.0d0)) (letm ((a (vector-double-float (a 1.0d0 2.0d0 3.0d0)))
(imax b)) (b (vector-double-float (a 3.0d0 4.0d0 5.0d0))))
(letm ((a (vector-double-float #(1.0d0 2.0d0 3.0d0)))
(b (vector-double-float #(3.0d0 4.0d0 5.0d0))))
(blas-swap a b) (blas-swap a b)
(data a)) (cl-array a))
(letm ((a (vector-double-float #(1.0d0 2.0d0 3.0d0))) (letm ((a (vector-double-float (a 1.0d0 2.0d0 3.0d0)))
(b (vector-double-float #(3.0d0 4.0d0 5.0d0)))) (b (vector-double-float (a 3.0d0 4.0d0 5.0d0))))
(blas-copy b a) (blas-copy b a)
(data a)) (cl-array a))
(letm ((a (vector-double-float #(1.0d0 2.0d0 3.0d0))) (letm ((a (vector-double-float (a 1.0d0 2.0d0 3.0d0)))
(b (vector-double-float #(3.0d0 4.0d0 5.0d0)))) (b (vector-double-float (a 3.0d0 4.0d0 5.0d0))))
(axpy 2.0d0 a b) (axpy 2.0d0 a b)
(data b)) (cl-array b))
(letm ((b (vector-double-float #(3.0d0 4.0d0 5.0d0)))) (letm ((b (vector-double-float (a 3.0d0 4.0d0 5.0d0))))
(scal 2.0d0 b) (scale 2.0d0 b)
(data b)) (cl-array b))
(letm ((a (vector-double-float #(1.0d0 3.0d0))) (letm ((a (vector-double-float (a 1.0d0 3.0d0)))
(b (vector-double-float #(8.0d0 9.0d0)))) (b (vector-double-float (a 8.0d0 9.0d0))))
(rot a b (/ (sqrt 2.0d0)) (/ (sqrt 2.0d0))) (givens-rotation a b (/ (sqrt 2.0d0)) (/ (sqrt 2.0d0)))
(data b))) (cl-array b)))
(LISP-UNIT:DEFINE-TEST BLAS1-SINGLE (LISP-UNIT:DEFINE-TEST BLAS1-SINGLE
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
...@@ -348,4 +339,3 @@ ...@@ -348,4 +339,3 @@
(ROT A B (/ (SQRT 2.0d0)) (/ (SQRT 2.0d0))) (ROT A B (/ (SQRT 2.0d0)) (/ (SQRT 2.0d0)))
(DATA B))))) (DATA B)))))
|# |#
;; LU decomposition ;; LU decomposition
;; Liam Healy, Thu Apr 27 2006 - 12:42 ;; Liam Healy, Thu Apr 27 2006 - 12:42
;; Time-stamp: <2008-09-21 15:25:09EDT lu.lisp> ;; Time-stamp: <2008-10-25 18:24:40EDT lu.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -144,18 +144,6 @@ ...@@ -144,18 +144,6 @@
(lu-invert mmat per inv) (lu-invert mmat per inv)
(cl-array inv))) (cl-array inv)))
#| (save-test lu
(make-tests lu (invert-matrix
(invert-matrix (make-array* '(2 2) 'double-float :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0))))
(make-array* '(2 2) 'double-float :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0))))
|#
(LISP-UNIT:DEFINE-TEST LU
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#2A((-1.9999999999999998 1.0)
(1.4999999999999998 -0.49999999999999994)))
(MULTIPLE-VALUE-LIST
(INVERT-MATRIX
(MAKE-ARRAY* '(2 2) 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(1.0 2.0 3.0 4.0))))))
;; Mathematical functions ;; Mathematical functions
;; Liam Healy, Wed Mar 8 2006 - 22:09 ;; Liam Healy, Wed Mar 8 2006 - 22:09
;; Time-stamp: <2008-02-17 09:13:19EST mathematical.lisp> ;; Time-stamp: <2008-10-25 19:09:09EDT mathematical.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -180,27 +180,18 @@ Function: double gsl_pow_9 (const double x) ...@@ -180,27 +180,18 @@ Function: double gsl_pow_9 (const double x)
;;;; Examples and unit test ;;;; Examples and unit test
;;;;**************************************************************************** ;;;;****************************************************************************
#| (save-test mathematical
(make-tests mathematical
(log+1 0.001d0) (log+1 0.001d0)
(exp-1 0.001d0) (exp-1 0.001d0)
(hypotenuse 3.0d0 4.0d0)) (hypotenuse 3.0d0 4.0d0))
|#
#|
;;; I would like to add
(lisp-unit:define-test mathematical (lisp-unit:define-test mathematical
(lisp-unit:assert-true (nanp +nan+)) (lisp-unit:assert-true (nanp +nan+))
(lisp-unit:assert-false (nanp 1.0d0)) (lisp-unit:assert-false (nanp 1.0d0))
(lisp-unit:assert-true (finitep 1.0d0)) (lisp-unit:assert-true (finitep 1.0d0))
(lisp-unit:assert-false (infinityp 1.0d0)) (lisp-unit:assert-false (infinityp 1.0d0))
(lisp-unit:assert-eq 1 (infinityp +positive-infinity+)) (lisp-unit:assert-eq 1 (infinityp +positive-infinity+))
(lisp-unit:assert-false (finitep +positive-infinity+)) (lisp-unit:assert-false (finitep +positive-infinity+)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL |#
(LIST 9.995003330835331d-4)
(MULTIPLE-VALUE-LIST (LOG+1 0.001d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.0010005001667083417d0)
(MULTIPLE-VALUE-LIST (EXP-1 0.001d0)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 5.0d0 2.220446049250313d-15)
(MULTIPLE-VALUE-LIST (HYPOTENUSE 3.0d0 4.0d0)))
(lisp-unit:assert-false (double-float-unequal 1.0d0 1.0d0 0.001d0)))
;; Monte Carlo Integration ;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42 ;; Liam Healy Sat Feb 3 2007 - 17:42
;; Time-stamp: <2008-08-21 21:58:28EDT monte-carlo.lisp> ;; Time-stamp: <2008-10-25 11:44:35EDT monte-carlo.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -313,21 +313,9 @@ ...@@ -313,21 +313,9 @@
(rng (random-number-generator *mt19937* 0))) (rng (random-number-generator *mt19937* 0)))
(monte-carlo-integrate-vegas monte-carlo-g lower upper nsamples rng ws))) (monte-carlo-integrate-vegas monte-carlo-g lower upper nsamples rng ws)))
#| (save-test monte-carlo
(make-tests monte-carlo
(random-walk-plain-example) (random-walk-plain-example)
(random-walk-miser-example) (random-walk-miser-example)
(random-walk-vegas-example)) (random-walk-vegas-example))
|#
(LISP-UNIT:DEFINE-TEST MONTE-CARLO
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.4122087033540667d0 0.013435861456267064d0)
(MULTIPLE-VALUE-LIST (RANDOM-WALK-PLAIN-EXAMPLE)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.3895297058825096d0 0.0050106269732269415d0)
(MULTIPLE-VALUE-LIST (RANDOM-WALK-MISER-EXAMPLE)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.3931632739551914d0 1.4981164744582692d-4)
(MULTIPLE-VALUE-LIST (RANDOM-WALK-VEGAS-EXAMPLE))))
;; Numerical differentiation. ;; Numerical differentiation.
;; Liam Healy Mon Nov 12 2007 - 22:07 ;; Liam Healy Mon Nov 12 2007 - 22:07
;; Time-stamp: <2008-09-20 18:23:28EDT numerical-differentiation.lisp> ;; Time-stamp: <2008-10-25 12:00:36EDT numerical-differentiation.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)