From 4458827b5a47067f6d417bbbc4e953653c0e9a78 Mon Sep 17 00:00:00 2001 From: "Liam M. Healy" <lhealy@common-lisp.net> Date: Wed, 17 Aug 2011 00:52:46 -0400 Subject: [PATCH] Fix test failures due to creation of wrong type of grid from #m macro --- calculus/monte-carlo.lisp | 6 +- eigensystems/symmetric-hermitian.lisp | 12 ++-- random/multinomial.lisp | 11 ++-- solve-minimize-fit/linear-least-squares.lisp | 37 ++++++----- solve-minimize-fit/minimization-multi.lisp | 60 ++++++++++-------- .../nonlinear-least-squares.lisp | 7 ++- solve-minimize-fit/roots-multi.lisp | 51 ++++++++-------- tests/absolute-sum.lisp | 55 +++++++++-------- tests/bessel.lisp | 5 +- tests/dirichlet.lisp | 47 +++++++------- tests/eigensystems.lisp | 17 +++--- tests/matrix-product-hermitian.lisp | 8 +-- tests/minimization-multi.lisp | 61 ++++++++++--------- tests/multinomial.lisp | 42 +++++++------ tests/shuffling-sampling.lisp | 14 +++-- 15 files changed, 240 insertions(+), 193 deletions(-) diff --git a/calculus/monte-carlo.lisp b/calculus/monte-carlo.lisp index fdd628e6..7734714d 100644 --- a/calculus/monte-carlo.lisp +++ b/calculus/monte-carlo.lisp @@ -1,6 +1,6 @@ ;; Monte Carlo Integration ;; Liam Healy Sat Feb 3 2007 - 17:42 -;; Time-stamp: <2011-01-10 17:59:20EST monte-carlo.lisp> +;; Time-stamp: <2011-08-16 23:54:40EDT monte-carlo.lisp> ;; ;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -208,7 +208,9 @@ (* (/ (expt dpi 3)) (/ (- 1 (* (cos x) (cos y) (cos z)))))) -(defparameter *mc-lower* #m(0.0d0 0.0d0 0.0d0)) +(defparameter *mc-lower* + (grid:make-foreign-array + 'double-float :initial-contents '(0.0d0 0.0d0 0.0d0))) (defparameter *mc-upper* (grid:make-foreign-array diff --git a/eigensystems/symmetric-hermitian.lisp b/eigensystems/symmetric-hermitian.lisp index 01534f33..eca25afc 100644 --- a/eigensystems/symmetric-hermitian.lisp +++ b/eigensystems/symmetric-hermitian.lisp @@ -1,6 +1,6 @@ ;; Eigenvectors and eigenvalues ;; Liam Healy, Sun May 21 2006 - 19:52 -;; Time-stamp: <2011-01-12 00:09:43EST symmetric-hermitian.lisp> +;; Time-stamp: <2011-08-17 00:18:16EDT symmetric-hermitian.lisp> ;; ;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -159,9 +159,13 @@ (defun eigenvalue-eigenvectors-example () (let ((evecs (grid:make-foreign-array 'double-float :dimensions '(3 3))) (evals (grid:make-foreign-array 'double-float :dimensions 3)) - (mat #m(20.0d0 -10.0d0 0.0d0 ^ - -10.0d0 30.0d0 0.0d0 ^ - 0.0d0 0.0d0 40.0d0))) + (mat + (grid:make-foreign-array + 'double-float + :initial-contents + '((20.0d0 -10.0d0 0.0d0) + (-10.0d0 30.0d0 0.0d0) + (0.0d0 0.0d0 40.0d0))))) (eigenvalues-eigenvectors mat evals evecs) (values (grid:copy-to evals) (grid:copy-to evecs)))) diff --git a/random/multinomial.lisp b/random/multinomial.lisp index adb12dbd..f9a96f4c 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: <2011-01-10 17:59:29EST multinomial.lisp> +;; Time-stamp: <2011-08-16 23:57:09EDT multinomial.lisp> ;; ;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -77,11 +77,14 @@ ;;; Examples and unit test (save-test multinomial (let ((rng (make-random-number-generator +mt19937+ 0)) - (p #m(0.1d0 0.2d0 0.3d0 0.4d0))) + (p (grid:make-foreign-array + 'double-float :initial-contents '(0.1d0 0.2d0 0.3d0 0.4d0)))) (grid:copy-to (sample rng :multinomial :sum 8 :probabilities p))) - (let ((p #m(0.1d0 0.2d0 0.3d0 0.4d0)) + (let ((p (grid:make-foreign-array + 'double-float :initial-contents '(0.1d0 0.2d0 0.3d0 0.4d0))) (n #31m(5 0 1 2))) (multinomial-pdf p N)) - (let ((p #m(0.1d0 0.2d0 0.3d0 0.4d0)) + (let ((p (grid:make-foreign-array + 'double-float :initial-contents '(0.1d0 0.2d0 0.3d0 0.4d0))) (n #31m(5 0 1 2))) (multinomial-log-pdf p n))) diff --git a/solve-minimize-fit/linear-least-squares.lisp b/solve-minimize-fit/linear-least-squares.lisp index a1482c80..f747dd2f 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: <2011-05-26 12:37:31EDT linear-least-squares.lisp> +;; Time-stamp: <2011-08-16 23:46:14EDT linear-least-squares.lisp> ;; ;; Copyright 2008, 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -302,9 +302,18 @@ (defun linear-least-squares-univariate-example (&optional (print-steps t)) "First example in Section 36.5 of the GSL manual." ;; Results not given in manual so not verified yet. - (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))) + (let ((x + (grid:make-foreign-array + 'double-float :initial-contents + '(1970.0d0 1980.0d0 1990.0d0 2000.0d0))) + (y + (grid:make-foreign-array + 'double-float :initial-contents + '(12.0d0 11.0d0 14.0d0 13.0d0))) + (w + (grid:make-foreign-array + 'double-float :initial-contents + '(0.1d0 0.2d0 0.3d0 0.4d0)))) (multiple-value-bind (c0 c1 cov00 cov01 cov11 chisq) (linear-fit x y w) (when print-steps @@ -313,18 +322,18 @@ cov00 cov01 cov01 cov11) (format t "Chisq = ~g~&" chisq) (loop for i from 0 below (dim0 x) - do + do (format t "data: ~12,5f ~12,5f ~12,5f~&" - (grid:aref x i) - (grid:aref y i) - (/ (grid:aref w i)))) + (grid:aref x i) + (grid:aref y i) + (/ (grid:aref w i)))) (loop for i from -30 below 130 by 10 ; don't print everything - for - xf = (+ (grid:aref x 0) - (* (/ i 100) - (- (grid:aref x (1- (dim0 x))) - (grid:aref x 0)))) - do + for + xf = (+ (grid:aref x 0) + (* (/ i 100) + (- (grid:aref x (1- (dim0 x))) + (grid:aref x 0)))) + do (multiple-value-bind (yf yferr) (linear-estimate xf c0 c1 cov00 cov01 cov11) (format t "fit:~6t~g ~g~&" xf yf) diff --git a/solve-minimize-fit/minimization-multi.lisp b/solve-minimize-fit/minimization-multi.lisp index 0da173bb..6a901f5b 100644 --- a/solve-minimize-fit/minimization-multi.lisp +++ b/solve-minimize-fit/minimization-multi.lisp @@ -1,8 +1,8 @@ ;; Multivariate minimization. ;; Liam Healy <Tue Jan 8 2008 - 21:28> -;; Time-stamp: <2011-05-26 12:37:32EDT minimization-multi.lisp> +;; Time-stamp: <2011-08-17 00:50:24EDT minimization-multi.lisp> ;; -;; Copyright 2008, 2009 Liam M. Healy +;; Copyright 2008, 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License ;; ;; This program is free software: you can redistribute it and/or modify @@ -372,22 +372,24 @@ (let ((minimizer (make-multi-dimensional-minimizer-f method 2 'paraboloid-scalar - #m(5.0d0 7.0d0) step-size))) + (grid:make-foreign-array + 'double-float :initial-contents '(5.0d0 7.0d0)) + step-size))) (loop with status = T and size - for iter from 0 below 100 - while status - do (iterate minimizer) - (setf size - (size minimizer) - status - (not (min-test-size size 1.0d-2))) - (when print-steps - (let ((x (solution minimizer))) - (format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f~&" - iter (grid:aref x 0) (grid:aref x 1) - (function-value minimizer) - size))) - finally + for iter from 0 below 100 + while status + do (iterate minimizer) + (setf size + (size minimizer) + status + (not (min-test-size size 1.0d-2))) + (when print-steps + (let ((x (solution minimizer))) + (format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f~&" + iter (grid:aref x 0) (grid:aref x 1) + (function-value minimizer) + size))) + finally (return (let ((x (solution minimizer))) (values (grid:aref x 0) (grid:aref x 1) (function-value minimizer)))))))) @@ -437,16 +439,18 @@ paraboloid-vector and paraboloid-derivative expect vectors. Contrast this with multimin-example-derivative-scalars, which expects and returns the scalar components." - (let* ((initial #m(5.0d0 7.0d0)) + (let* ((initial + (grid:make-foreign-array + 'double-float :initial-contents '(5.0d0 7.0d0))) (minimizer (make-multi-dimensional-minimizer-fdf method 2 '(paraboloid-vector paraboloid-derivative paraboloid-and-derivative) initial 0.01d0 1.0d-4 nil))) (loop with status = T - for iter from 0 below 100 - while status - do + for iter from 0 below 100 + while status + do (iterate minimizer) (setf status (not (min-test-gradient @@ -457,7 +461,7 @@ (format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~&" iter (grid:aref x 0) (grid:aref x 1) (function-value minimizer)))) - finally + finally (return (let ((x (solution minimizer))) (values (grid:aref x 0) (grid:aref x 1) (function-value minimizer))))))) @@ -481,16 +485,18 @@ paraboloid-scalar and paraboloid-derivative-scalar expect scalars. Contrast this with multimin-example-derivative, which expects and returns vectors." - (let* ((initial #m(5.0d0 7.0d0)) + (let* ((initial + (grid:make-foreign-array + 'double-float :initial-contents '(5.0d0 7.0d0))) (minimizer (make-multi-dimensional-minimizer-fdf method 2 '(paraboloid-scalar paraboloid-derivative-scalar paraboloid-and-derivative-scalar) initial 0.01d0 1.0d-4 t))) (loop with status = T - for iter from 0 below 100 - while status - do + for iter from 0 below 100 + while status + do (iterate minimizer) (setf status (not (min-test-gradient @@ -501,7 +507,7 @@ (format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~&" iter (grid:aref x 0) (grid:aref x 1) (function-value minimizer)))) - finally + finally (return (let ((x (solution minimizer))) (values (grid:aref x 0) (grid:aref x 1) (function-value minimizer))))))) diff --git a/solve-minimize-fit/nonlinear-least-squares.lisp b/solve-minimize-fit/nonlinear-least-squares.lisp index 5761538a..77649fb1 100644 --- a/solve-minimize-fit/nonlinear-least-squares.lisp +++ b/solve-minimize-fit/nonlinear-least-squares.lisp @@ -1,8 +1,8 @@ ;; Nonlinear least squares fitting. ;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp -;; Time-stamp: <2011-05-26 12:37:32EDT nonlinear-least-squares.lisp> +;; Time-stamp: <2011-08-17 00:50:45EDT nonlinear-least-squares.lisp> ;; -;; Copyright 2008, 2009 Liam M. Healy +;; Copyright 2008, 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License ;; ;; This program is free software: you can redistribute it and/or modify @@ -354,7 +354,8 @@ (method +levenberg-marquardt+) (print-steps t)) (let ((*nlls-example-data* (generate-nlls-data number-of-observations))) - (let* ((init #m(1.0d0 0.0d0 0.0d0)) + (let* ((init + (grid:make-foreign-array 'double-float :initial-contents '(1.0d0 0.0d0 0.0d0))) (number-of-parameters 3) covariance (fit (make-nonlinear-fdffit diff --git a/solve-minimize-fit/roots-multi.lisp b/solve-minimize-fit/roots-multi.lisp index 718065ee..ae019827 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: <2011-05-26 12:37:31EDT roots-multi.lisp> +;;; Time-stamp: <2011-08-16 23:58:35EDT roots-multi.lisp> ;; ;; Copyright 2008, 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License @@ -405,13 +405,15 @@ "Solving Rosenbrock, the example given in Sec. 34.8 of the GSL manual." (let ((max-iter 1000) (solver (make-multi-dimensional-root-solver-f - method 'rosenbrock #m(-10.0d0 -5.0d0)))) + method 'rosenbrock + (grid:make-foreign-array + 'double-float :initial-contents '(-10.0d0 -5.0d0))))) (loop for iter from 0 - with fnval and argval - while (and (< iter max-iter) - (or (zerop iter) - (not (multiroot-test-residual solver 1.0d-7)))) - do + with fnval and argval + while (and (< iter max-iter) + (or (zerop iter) + (not (multiroot-test-residual solver 1.0d-7)))) + do (iterate solver) (setf fnval (function-value solver) argval (solution solver)) @@ -422,11 +424,11 @@ (grid:aref argval 1) (grid:aref fnval 0) (grid:aref fnval 1))) - finally (return - (values (grid:aref argval 0) - (grid:aref argval 1) - (grid:aref fnval 0) - (grid:aref fnval 1)))))) + finally (return + (values (grid:aref argval 0) + (grid:aref argval 1) + (grid:aref fnval 0) + (grid:aref fnval 1)))))) (defun rosenbrock-df (arg0 arg1) "The partial derivatives of the Rosenbrock functions." @@ -460,23 +462,24 @@ (solver (make-multi-dimensional-root-solver-fdf method '(rosenbrock rosenbrock-df rosenbrock-fdf) - #m(-10.0d0 -5.0d0)))) + (grid:make-foreign-array + 'double-float :initial-contents '(-10.0d0 -5.0d0))))) (loop for iter from 0 - with fnval = (function-value solver) - and argval = (solution solver) - while (and (< iter max-iter) - (not (multiroot-test-residual solver 1.0d-7))) - initially (print-state iter argval fnval) - do + with fnval = (function-value solver) + and argval = (solution solver) + while (and (< iter max-iter) + (not (multiroot-test-residual solver 1.0d-7))) + initially (print-state iter argval fnval) + do (iterate solver) (setf fnval (function-value solver) argval (solution solver)) (print-state iter argval fnval) - finally (return - (values (grid:aref argval 0) - (grid:aref argval 1) - (grid:aref fnval 0) - (grid:aref fnval 1))))))) + finally (return + (values (grid:aref argval 0) + (grid:aref argval 1) + (grid:aref fnval 0) + (grid:aref fnval 1))))))) ;; To see step-by-step information as the solution progresses, make ;; the last argument T. diff --git a/tests/absolute-sum.lisp b/tests/absolute-sum.lisp index e77374b5..7d188f0f 100644 --- a/tests/absolute-sum.lisp +++ b/tests/absolute-sum.lisp @@ -19,39 +19,42 @@ (in-package :gsl) (LISP-UNIT:DEFINE-TEST ABSOLUTE-SUM - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST 157.99f0) - (MULTIPLE-VALUE-LIST - (LET ((V1 - (GRID:MAKE-FOREIGN-ARRAY - 'SINGLE-FLOAT - :INITIAL-CONTENTS - '(-34.5f0 8.24f0 3.29f0 -8.93f0 34.12f0 -6.15f0 49.27f0 -13.49f0)))) - (ABSOLUTE-SUM V1)))) + (LISP-UNIT::ASSERT-NUMERICAL-EQUAL + (LIST 157.99f0) + (MULTIPLE-VALUE-LIST + (LET ((V1 + (GRID:MAKE-FOREIGN-ARRAY + 'SINGLE-FLOAT + :INITIAL-CONTENTS + '(-34.5f0 8.24f0 3.29f0 -8.93f0 34.12f0 -6.15f0 49.27f0 -13.49f0)))) + (ABSOLUTE-SUM V1)))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 157.99d0) (MULTIPLE-VALUE-LIST - (LET ((V1 - (GRID:MAKE-FOREIGN-ARRAY - 'DOUBLE-FLOAT - :INITIAL-CONTENTS - '(-34.5d0 8.24d0 3.29d0 -8.93d0 34.12d0 -6.15d0 49.27d0 -13.49d0)))) - (ABSOLUTE-SUM V1)))) + (LET ((V1 + (GRID:MAKE-FOREIGN-ARRAY + 'DOUBLE-FLOAT + :INITIAL-CONTENTS + '(-34.5d0 8.24d0 3.29d0 -8.93d0 34.12d0 -6.15d0 49.27d0 -13.49d0)))) + (ABSOLUTE-SUM V1)))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 388.65997f0) (MULTIPLE-VALUE-LIST - (LET ((V1 - (GRID:MAKE-FOREIGN-ARRAY - '(COMPLEX SINGLE-FLOAT) - :INITIAL-CONTENTS - '(#C(-34.5f0 8.24f0) #C(3.29f0 -8.93f0) #C(34.12f0 -6.15f0) #C(49.27f0 -13.49f0) - #C(32.5f0 42.73f0) #C(-17.24f0 43.31f0) #C(-16.12f0 -8.25f0) #C(21.44f0 -49.08f0))))) - (ABSOLUTE-SUM V1)))) + (LET ((V1 + (GRID:MAKE-FOREIGN-ARRAY + '(COMPLEX SINGLE-FLOAT) + :INITIAL-CONTENTS + '(#C(-34.5f0 8.24f0) #C(3.29f0 -8.93f0) #C(34.12f0 -6.15f0) #C(49.27f0 -13.49f0) + #C(32.5f0 42.73f0) #C(-17.24f0 43.31f0) #C(-16.12f0 -8.25f0) #C(21.44f0 -49.08f0))))) + (ABSOLUTE-SUM V1)))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 388.65999999999997d0) (MULTIPLE-VALUE-LIST - (LET ((V1 - #2m(#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) #C(34.12d0 -6.15d0) + (LET ((V1 + (grid:make-foreign-array + '(complex double-float) + :INITIAL-CONTENTS + '(#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) #C(34.12d0 -6.15d0) #C(49.27d0 -13.49d0) #C(32.5d0 42.73d0) #C(-17.24d0 43.31d0) - #C(-16.12d0 -8.25d0) #C(21.44d0 -49.08d0)))) - (ABSOLUTE-SUM V1))))) + #C(-16.12d0 -8.25d0) #C(21.44d0 -49.08d0))))) + (ABSOLUTE-SUM V1))))) diff --git a/tests/bessel.lisp b/tests/bessel.lisp index 27e755d0..59c8dcd5 100644 --- a/tests/bessel.lisp +++ b/tests/bessel.lisp @@ -240,7 +240,10 @@ #(0.6713967071418024d0 0.5130161365618323d0 0.06500818287738516d0)) (MULTIPLE-VALUE-LIST - (grid:copy-to (cylindrical-bessel-J-array-x 0.5d0 #m(1.0d0 2.0d0 3.0d0))))) + (grid:copy-to + (cylindrical-bessel-J-array-x + 0.5d0 + (grid:make-foreign-array 'double-float :initial-contents '(1.0d0 2.0d0 3.0d0)))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST -0.1820221159534852d0 2.020851441225493d-15) (MULTIPLE-VALUE-LIST (cylindrical-bessel-Y 3.0d0 4.0d0))) diff --git a/tests/dirichlet.lisp b/tests/dirichlet.lisp index 7740e812..cf9794a1 100644 --- a/tests/dirichlet.lisp +++ b/tests/dirichlet.lisp @@ -19,31 +19,34 @@ (in-package :gsl) (LISP-UNIT:DEFINE-TEST DIRICHLET - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST - #(0.12448073544131681d0 0.19182353706734917d0 - 0.46054388544826397d0 0.22315184204307006d0)) - (MULTIPLE-VALUE-LIST - (let ((rng (make-random-number-generator +mt19937+ 0)) - (alpha #m(1.0d0 2.0d0 3.0d0 4.0d0))) - (grid:copy-to (sample rng :dirichlet :alpha alpha))))) + (LISP-UNIT::ASSERT-NUMERICAL-EQUAL + (LIST + #(0.12448073544131681d0 0.19182353706734917d0 + 0.46054388544826397d0 0.22315184204307006d0)) + (MULTIPLE-VALUE-LIST + (let ((rng (make-random-number-generator +mt19937+ 0)) + (alpha + (GRID:MAKE-FOREIGN-ARRAY + 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(1.0d0 2.0d0 3.0d0 4.0d0)))) + (grid:copy-to (sample rng :dirichlet :alpha alpha))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (list 3.483648000000004d7) (MULTIPLE-VALUE-LIST - (LET ((ALPHA - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(1.0d0 2.0d0 3.0d0 4.0d0))) - (THETA - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(1.0d0 2.0d0 3.0d0 4.0d0)))) - (DIRICHLET-PDF ALPHA THETA)))) + (LET ((ALPHA + (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(1.0d0 2.0d0 3.0d0 4.0d0))) + (THETA + (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(1.0d0 2.0d0 3.0d0 4.0d0)))) + (DIRICHLET-PDF ALPHA THETA)))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (list 17.366175671549307d0) (MULTIPLE-VALUE-LIST - (LET ((ALPHA - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(1.0d0 2.0d0 3.0d0 4.0d0))) - (THETA - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(1.0d0 2.0d0 3.0d0 4.0d0)))) - (DIRICHLET-LOG-PDF ALPHA THETA))))) + (LET ((ALPHA + (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(1.0d0 2.0d0 3.0d0 4.0d0))) + (THETA + (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(1.0d0 2.0d0 3.0d0 4.0d0)))) + (DIRICHLET-LOG-PDF ALPHA THETA))))) diff --git a/tests/eigensystems.lisp b/tests/eigensystems.lisp index fb277f76..f77fb16a 100644 --- a/tests/eigensystems.lisp +++ b/tests/eigensystems.lisp @@ -19,12 +19,11 @@ (in-package :gsl) (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)))) - + (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)))) diff --git a/tests/matrix-product-hermitian.lisp b/tests/matrix-product-hermitian.lisp index 6bc1bfb0..b0aed305 100644 --- a/tests/matrix-product-hermitian.lisp +++ b/tests/matrix-product-hermitian.lisp @@ -50,8 +50,8 @@ '((#C(19.68 -5.55) #C(-8.82 25.37) #C(-30.58 31.67)) (#C(25.37 -30.58) #C(31.67 29.36) #C(-33.24 -27.03)) (#C(29.36 -33.24) #C(-27.03 -41.67) #C(42.0 -20.81))))) - (S1 #C(-41.67 42.0)) - (S2 #C(42.0 -20.81))) + (S1 #C(-41.67f0 42.0f0)) + (S2 #C(42.0f0 -20.81f0))) (GRID:COPY-TO (MATRIX-PRODUCT-HERMITIAN M1 M2 M3 S1 S2))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL @@ -113,8 +113,8 @@ '(COMPLEX SINGLE-FLOAT) :INITIAL-CONTENTS '(#C(-16.12 -8.25) #C(21.44 -49.08) #C(-39.66 -49.46)))) - (S1 #C(-49.08 -39.66)) - (S2 #C(-39.66 -49.46))) + (S1 #C(-49.08f0 -39.66f0)) + (S2 #C(-39.66f0 -49.46f0))) (GRID:COPY-TO (MATRIX-PRODUCT-HERMITIAN M1 V1 V2 S1 S2))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL diff --git a/tests/minimization-multi.lisp b/tests/minimization-multi.lisp index ee47926b..a97d8137 100644 --- a/tests/minimization-multi.lisp +++ b/tests/minimization-multi.lisp @@ -19,33 +19,36 @@ (in-package :gsl) (LISP-UNIT:DEFINE-TEST MINIMIZATION-MULTI - (LISP-UNIT:ASSERT-NUMERICAL-EQUAL - (LIST 0.9920430849306285d0 1.9969168063253164d0 - 30.000823246638923d0) - (MULTIPLE-VALUE-LIST - (MULTIMIN-EXAMPLE-NO-DERIVATIVE - +SIMPLEX-NELDER-MEAD-ON2+ NIL))) - (LISP-UNIT:ASSERT-NUMERICAL-EQUAL - (LIST 0.9999999999999997d0 2.0d0 30.0d0) - (MULTIPLE-VALUE-LIST - (MULTIMIN-EXAMPLE-DERIVATIVE - +CONJUGATE-FLETCHER-REEVES+ NIL))) - (LISP-UNIT:ASSERT-NUMERICAL-EQUAL - (LIST 0.9999999999999997d0 2.0d0 30.0d0) - (MULTIPLE-VALUE-LIST - (MULTIMIN-EXAMPLE-DERIVATIVE +CONJUGATE-POLAK-RIBIERE+ - NIL))) - (LISP-UNIT:ASSERT-NUMERICAL-EQUAL - (LIST 0.9999999999999997d0 2.0d0 30.0d0) - (MULTIPLE-VALUE-LIST - (MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS+ NIL))) - (LISP-UNIT:ASSERT-NUMERICAL-EQUAL - (LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0) - (MULTIPLE-VALUE-LIST - (MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS2+ NIL))) - (LISP-UNIT:ASSERT-NUMERICAL-EQUAL - (LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0) - (MULTIPLE-VALUE-LIST - (MULTIMIN-EXAMPLE-DERIVATIVE-SCALARS +VECTOR-BFGS2+ - NIL)))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST 0.9920430849306285d0 1.9969168063253164d0 + 30.000823246638923d0) + (MULTIPLE-VALUE-LIST + (MULTIMIN-EXAMPLE-NO-DERIVATIVE + +SIMPLEX-NELDER-MEAD-ON2+ NIL))) + (let ((lisp-unit:*epsilon* (* 10 double-float-epsilon))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST 0.9999999999999997d0 2.0d0 30.0d0) + (MULTIPLE-VALUE-LIST + (MULTIMIN-EXAMPLE-DERIVATIVE + +CONJUGATE-FLETCHER-REEVES+ NIL)))) + (let ((lisp-unit:*epsilon* (* 10 double-float-epsilon))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST 0.9999999999999997d0 2.0d0 30.0d0) + (MULTIPLE-VALUE-LIST + (MULTIMIN-EXAMPLE-DERIVATIVE +CONJUGATE-POLAK-RIBIERE+ + NIL)))) + (let ((lisp-unit:*epsilon* (* 10 double-float-epsilon))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST 0.9999999999999997d0 2.0d0 30.0d0) + (MULTIPLE-VALUE-LIST + (MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS+ NIL)))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0) + (MULTIPLE-VALUE-LIST + (MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS2+ NIL))) + (LISP-UNIT:ASSERT-NUMERICAL-EQUAL + (LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0) + (MULTIPLE-VALUE-LIST + (MULTIMIN-EXAMPLE-DERIVATIVE-SCALARS +VECTOR-BFGS2+ + NIL)))) diff --git a/tests/multinomial.lisp b/tests/multinomial.lisp index b54562d5..b6f04c14 100644 --- a/tests/multinomial.lisp +++ b/tests/multinomial.lisp @@ -19,30 +19,32 @@ (in-package :gsl) (LISP-UNIT:DEFINE-TEST MULTINOMIAL - (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(5 0 1 2)) - (MULTIPLE-VALUE-LIST - (let ((rng (make-random-number-generator +mt19937+ 0)) - (p #m(0.1d0 0.2d0 0.3d0 0.4d0))) - (grid:copy-to (sample rng :multinomial :sum 8 :probabilities p))))) + (LISP-UNIT::ASSERT-NUMERICAL-EQUAL + (LIST #(5 0 1 2)) + (MULTIPLE-VALUE-LIST + (let ((rng (make-random-number-generator +mt19937+ 0)) + (p + (grid:make-foreign-array + 'double-float :initial-contents '(0.1d0 0.2d0 0.3d0 0.4d0)))) + (grid:copy-to (sample rng :multinomial :sum 8 :probabilities p))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 8.064000000000026d-5) (MULTIPLE-VALUE-LIST - (LET ((P - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(0.1d0 0.2d0 0.3d0 0.4d0))) - (N - (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTENTS '(5 0 1 2)))) - (MULTINOMIAL-PDF P N)))) + (LET ((P + (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(0.1d0 0.2d0 0.3d0 0.4d0))) + (N + (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32) + :INITIAL-CONTENTS '(5 0 1 2)))) + (MULTINOMIAL-PDF P N)))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST -9.425515753641212d0) (MULTIPLE-VALUE-LIST - (LET ((P - (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS - '(0.1d0 0.2d0 0.3d0 0.4d0))) - (N - (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32) - :INITIAL-CONTENTS '(5 0 1 2)))) - (MULTINOMIAL-LOG-PDF P N))))) + (LET ((P + (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(0.1d0 0.2d0 0.3d0 0.4d0))) + (N + (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32) + :INITIAL-CONTENTS '(5 0 1 2)))) + (MULTINOMIAL-LOG-PDF P N))))) diff --git a/tests/shuffling-sampling.lisp b/tests/shuffling-sampling.lisp index 814e08c7..d403aa96 100644 --- a/tests/shuffling-sampling.lisp +++ b/tests/shuffling-sampling.lisp @@ -1,6 +1,6 @@ ;; Regression test SHUFFLING-SAMPLING for GSLL, automatically generated ;; -;; Copyright 2009 Liam M. Healy +;; Copyright 2009, 2011 Liam M. Healy ;; Distributed under the terms of the GNU General Public License ;; ;; This program is free software: you can redistribute it and/or modify @@ -23,17 +23,23 @@ (LIST #(4 3 6 1 5 7 2 8)) (MULTIPLE-VALUE-LIST (let ((rng (make-random-number-generator +mt19937+ 0)) - (v1 #31m(1 2 3 4 5 6 7 8))) + (v1 + (grid:make-foreign-array + '(signed-byte 32) :initial-contents '(1 2 3 4 5 6 7 8)))) (grid:copy-to (sample rng :shuffle :base v1))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(2 3 5 8)) (MULTIPLE-VALUE-LIST (let ((rng (make-random-number-generator +mt19937+ 0)) - (v1 #31m(1 2 3 4 5 6 7 8))) + (v1 + (grid:make-foreign-array + '(signed-byte 32) :initial-contents '(1 2 3 4 5 6 7 8)))) (grid:copy-to (sample rng :choose-random :src v1 :dest 4))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(8 2 3 8 2 4 8 6 5 6)) (MULTIPLE-VALUE-LIST (let ((rng (make-random-number-generator +mt19937+ 0)) - (v1 #31m(1 2 3 4 5 6 7 8))) + (v1 + (grid:make-foreign-array + '(signed-byte 32) :initial-contents '(1 2 3 4 5 6 7 8)))) (grid:copy-to (sample rng :random-sample :src v1 :dest 10)))))) -- GitLab