Commit 4458827b authored by Liam Healy's avatar Liam Healy

Fix test failures due to creation of wrong type of grid from #m macro

parent 2a877243
;; Monte Carlo Integration ;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42 ;; 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 ;; Copyright 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -208,7 +208,9 @@ ...@@ -208,7 +208,9 @@
(* (/ (expt dpi 3)) (* (/ (expt dpi 3))
(/ (- 1 (* (cos x) (cos y) (cos z)))))) (/ (- 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* (defparameter *mc-upper*
(grid:make-foreign-array (grid:make-foreign-array
......
;; Eigenvectors and eigenvalues ;; Eigenvectors and eigenvalues
;; Liam Healy, Sun May 21 2006 - 19:52 ;; 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 ;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -159,9 +159,13 @@ ...@@ -159,9 +159,13 @@
(defun eigenvalue-eigenvectors-example () (defun eigenvalue-eigenvectors-example ()
(let ((evecs (grid:make-foreign-array 'double-float :dimensions '(3 3))) (let ((evecs (grid:make-foreign-array 'double-float :dimensions '(3 3)))
(evals (grid:make-foreign-array 'double-float :dimensions 3)) (evals (grid:make-foreign-array 'double-float :dimensions 3))
(mat #m(20.0d0 -10.0d0 0.0d0 ^ (mat
-10.0d0 30.0d0 0.0d0 ^ (grid:make-foreign-array
0.0d0 0.0d0 40.0d0))) '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) (eigenvalues-eigenvectors mat evals evecs)
(values (grid:copy-to evals) (grid:copy-to evecs)))) (values (grid:copy-to evals) (grid:copy-to evecs))))
......
;; Multinomial distribution ;; Multinomial distribution
;; Liam Healy, Sat Nov 25 2006 - 16:00 ;; 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 ;; Copyright 2006, 2007, 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -77,11 +77,14 @@ ...@@ -77,11 +77,14 @@
;;; Examples and unit test ;;; Examples and unit test
(save-test multinomial (save-test multinomial
(let ((rng (make-random-number-generator +mt19937+ 0)) (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))) (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))) (n #31m(5 0 1 2)))
(multinomial-pdf p N)) (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))) (n #31m(5 0 1 2)))
(multinomial-log-pdf p n))) (multinomial-log-pdf p n)))
;; Linear least squares, or linear regression ;; Linear least squares, or linear regression
;; Liam Healy <2008-01-21 12:41:46EST linear-least-squares.lisp> ;; 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 ;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -302,9 +302,18 @@ ...@@ -302,9 +302,18 @@
(defun linear-least-squares-univariate-example (&optional (print-steps t)) (defun linear-least-squares-univariate-example (&optional (print-steps t))
"First example in Section 36.5 of the GSL manual." "First example in Section 36.5 of the GSL manual."
;; Results not given in manual so not verified yet. ;; Results not given in manual so not verified yet.
(let ((x #m(1970.0d0 1980.0d0 1990.0d0 2000.0d0)) (let ((x
(y #m(12.0d0 11.0d0 14.0d0 13.0d0)) (grid:make-foreign-array
(w #m(0.1d0 0.2d0 0.3d0 0.4d0))) '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) (multiple-value-bind (c0 c1 cov00 cov01 cov11 chisq)
(linear-fit x y w) (linear-fit x y w)
(when print-steps (when print-steps
...@@ -313,18 +322,18 @@ ...@@ -313,18 +322,18 @@
cov00 cov01 cov01 cov11) cov00 cov01 cov01 cov11)
(format t "Chisq = ~g~&" chisq) (format t "Chisq = ~g~&" chisq)
(loop for i from 0 below (dim0 x) (loop for i from 0 below (dim0 x)
do do
(format t "data: ~12,5f ~12,5f ~12,5f~&" (format t "data: ~12,5f ~12,5f ~12,5f~&"
(grid:aref x i) (grid:aref x i)
(grid:aref y i) (grid:aref y i)
(/ (grid:aref w i)))) (/ (grid:aref w i))))
(loop for i from -30 below 130 by 10 ; don't print everything (loop for i from -30 below 130 by 10 ; don't print everything
for for
xf = (+ (grid:aref x 0) xf = (+ (grid:aref x 0)
(* (/ i 100) (* (/ i 100)
(- (grid:aref x (1- (dim0 x))) (- (grid:aref x (1- (dim0 x)))
(grid:aref x 0)))) (grid:aref x 0))))
do do
(multiple-value-bind (yf yferr) (multiple-value-bind (yf yferr)
(linear-estimate xf c0 c1 cov00 cov01 cov11) (linear-estimate xf c0 c1 cov00 cov01 cov11)
(format t "fit:~6t~g ~g~&" xf yf) (format t "fit:~6t~g ~g~&" xf yf)
......
;; Multivariate minimization. ;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28> ;; 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 ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -372,22 +372,24 @@ ...@@ -372,22 +372,24 @@
(let ((minimizer (let ((minimizer
(make-multi-dimensional-minimizer-f (make-multi-dimensional-minimizer-f
method 2 'paraboloid-scalar 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 (loop with status = T and size
for iter from 0 below 100 for iter from 0 below 100
while status while status
do (iterate minimizer) do (iterate minimizer)
(setf size (setf size
(size minimizer) (size minimizer)
status status
(not (min-test-size size 1.0d-2))) (not (min-test-size size 1.0d-2)))
(when print-steps (when print-steps
(let ((x (solution minimizer))) (let ((x (solution minimizer)))
(format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f~&" (format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f~&"
iter (grid:aref x 0) (grid:aref x 1) iter (grid:aref x 0) (grid:aref x 1)
(function-value minimizer) (function-value minimizer)
size))) size)))
finally finally
(return (return
(let ((x (solution minimizer))) (let ((x (solution minimizer)))
(values (grid:aref x 0) (grid:aref x 1) (function-value minimizer)))))))) (values (grid:aref x 0) (grid:aref x 1) (function-value minimizer))))))))
...@@ -437,16 +439,18 @@ ...@@ -437,16 +439,18 @@
paraboloid-vector and paraboloid-derivative expect vectors. paraboloid-vector and paraboloid-derivative expect vectors.
Contrast this with multimin-example-derivative-scalars, which Contrast this with multimin-example-derivative-scalars, which
expects and returns the scalar components." 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 (minimizer
(make-multi-dimensional-minimizer-fdf (make-multi-dimensional-minimizer-fdf
method 2 method 2
'(paraboloid-vector paraboloid-derivative paraboloid-and-derivative) '(paraboloid-vector paraboloid-derivative paraboloid-and-derivative)
initial 0.01d0 1.0d-4 nil))) initial 0.01d0 1.0d-4 nil)))
(loop with status = T (loop with status = T
for iter from 0 below 100 for iter from 0 below 100
while status while status
do do
(iterate minimizer) (iterate minimizer)
(setf status (setf status
(not (min-test-gradient (not (min-test-gradient
...@@ -457,7 +461,7 @@ ...@@ -457,7 +461,7 @@
(format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~&" (format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~&"
iter (grid:aref x 0) (grid:aref x 1) iter (grid:aref x 0) (grid:aref x 1)
(function-value minimizer)))) (function-value minimizer))))
finally finally
(return (return
(let ((x (solution minimizer))) (let ((x (solution minimizer)))
(values (grid:aref x 0) (grid:aref x 1) (function-value minimizer))))))) (values (grid:aref x 0) (grid:aref x 1) (function-value minimizer)))))))
...@@ -481,16 +485,18 @@ ...@@ -481,16 +485,18 @@
paraboloid-scalar and paraboloid-derivative-scalar expect scalars. paraboloid-scalar and paraboloid-derivative-scalar expect scalars.
Contrast this with multimin-example-derivative, which Contrast this with multimin-example-derivative, which
expects and returns vectors." 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 (minimizer
(make-multi-dimensional-minimizer-fdf (make-multi-dimensional-minimizer-fdf
method 2 method 2
'(paraboloid-scalar paraboloid-derivative-scalar paraboloid-and-derivative-scalar) '(paraboloid-scalar paraboloid-derivative-scalar paraboloid-and-derivative-scalar)
initial 0.01d0 1.0d-4 t))) initial 0.01d0 1.0d-4 t)))
(loop with status = T (loop with status = T
for iter from 0 below 100 for iter from 0 below 100
while status while status
do do
(iterate minimizer) (iterate minimizer)
(setf status (setf status
(not (min-test-gradient (not (min-test-gradient
...@@ -501,7 +507,7 @@ ...@@ -501,7 +507,7 @@
(format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~&" (format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~&"
iter (grid:aref x 0) (grid:aref x 1) iter (grid:aref x 0) (grid:aref x 1)
(function-value minimizer)))) (function-value minimizer))))
finally finally
(return (return
(let ((x (solution minimizer))) (let ((x (solution minimizer)))
(values (grid:aref x 0) (grid:aref x 1) (function-value minimizer))))))) (values (grid:aref x 0) (grid:aref x 1) (function-value minimizer)))))))
......
;; Nonlinear least squares fitting. ;; Nonlinear least squares fitting.
;; Liam Healy, 2008-02-09 12:59:16EST nonlinear-least-squares.lisp ;; 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 ;; Distributed under the terms of the GNU General Public License
;; ;;
;; This program is free software: you can redistribute it and/or modify ;; This program is free software: you can redistribute it and/or modify
...@@ -354,7 +354,8 @@ ...@@ -354,7 +354,8 @@
(method +levenberg-marquardt+) (method +levenberg-marquardt+)
(print-steps t)) (print-steps t))
(let ((*nlls-example-data* (generate-nlls-data number-of-observations))) (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) (number-of-parameters 3)
covariance covariance
(fit (make-nonlinear-fdffit (fit (make-nonlinear-fdffit
......
;;; Multivariate roots. ;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08 ;;; 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 ;; Copyright 2008, 2009, 2011 Liam M. Healy
;; Distributed under the terms of the GNU General Public License ;; Distributed under the terms of the GNU General Public License
...@@ -405,13 +405,15 @@ ...@@ -405,13 +405,15 @@
"Solving Rosenbrock, the example given in Sec. 34.8 of the GSL manual." "Solving Rosenbrock, the example given in Sec. 34.8 of the GSL manual."
(let ((max-iter 1000) (let ((max-iter 1000)
(solver (make-multi-dimensional-root-solver-f (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 (loop for iter from 0
with fnval and argval with fnval and argval
while (and (< iter max-iter) while (and (< iter max-iter)
(or (zerop iter) (or (zerop iter)
(not (multiroot-test-residual solver 1.0d-7)))) (not (multiroot-test-residual solver 1.0d-7))))
do do
(iterate solver) (iterate solver)
(setf fnval (function-value solver) (setf fnval (function-value solver)
argval (solution solver)) argval (solution solver))
...@@ -422,11 +424,11 @@ ...@@ -422,11 +424,11 @@
(grid:aref argval 1) (grid:aref argval 1)
(grid:aref fnval 0) (grid:aref fnval 0)
(grid:aref fnval 1))) (grid:aref fnval 1)))
finally (return finally (return
(values (grid:aref argval 0) (values (grid:aref argval 0)
(grid:aref argval 1) (grid:aref argval 1)
(grid:aref fnval 0) (grid:aref fnval 0)
(grid:aref fnval 1)))))) (grid:aref fnval 1))))))
(defun rosenbrock-df (arg0 arg1) (defun rosenbrock-df (arg0 arg1)
"The partial derivatives of the Rosenbrock functions." "The partial derivatives of the Rosenbrock functions."
...@@ -460,23 +462,24 @@ ...@@ -460,23 +462,24 @@
(solver (make-multi-dimensional-root-solver-fdf (solver (make-multi-dimensional-root-solver-fdf
method method
'(rosenbrock rosenbrock-df rosenbrock-fdf) '(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 (loop for iter from 0
with fnval = (function-value solver) with fnval = (function-value solver)
and argval = (solution solver) and argval = (solution solver)
while (and (< iter max-iter) while (and (< iter max-iter)
(not (multiroot-test-residual solver 1.0d-7))) (not (multiroot-test-residual solver 1.0d-7)))
initially (print-state iter argval fnval) initially (print-state iter argval fnval)
do do
(iterate solver) (iterate solver)
(setf fnval (function-value solver) (setf fnval (function-value solver)
argval (solution solver)) argval (solution solver))
(print-state iter argval fnval) (print-state iter argval fnval)
finally (return finally (return
(values (grid:aref argval 0) (values (grid:aref argval 0)
(grid:aref argval 1) (grid:aref argval 1)
(grid:aref fnval 0) (grid:aref fnval 0)
(grid:aref fnval 1))))))) (grid:aref fnval 1)))))))
;; To see step-by-step information as the solution progresses, make ;; To see step-by-step information as the solution progresses, make
;; the last argument T. ;; the last argument T.
......
...@@ -19,39 +19,42 @@ ...@@ -19,39 +19,42 @@
(in-package :gsl) (in-package :gsl)
(LISP-UNIT:DEFINE-TEST ABSOLUTE-SUM (LISP-UNIT:DEFINE-TEST ABSOLUTE-SUM
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 157.99f0) (LIST 157.99f0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((V1 (LET ((V1
(GRID:MAKE-FOREIGN-ARRAY (GRID:MAKE-FOREIGN-ARRAY
'SINGLE-FLOAT 'SINGLE-FLOAT
:INITIAL-CONTENTS :INITIAL-CONTENTS
'(-34.5f0 8.24f0 3.29f0 -8.93f0 34.12f0 -6.15f0 49.27f0 -13.49f0)))) '(-34.5f0 8.24f0 3.29f0 -8.93f0 34.12f0 -6.15f0 49.27f0 -13.49f0))))
(ABSOLUTE-SUM V1)))) (ABSOLUTE-SUM V1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 157.99d0) (LIST 157.99d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((V1 (LET ((V1
(GRID:MAKE-FOREIGN-ARRAY (GRID:MAKE-FOREIGN-ARRAY
'DOUBLE-FLOAT 'DOUBLE-FLOAT
:INITIAL-CONTENTS :INITIAL-CONTENTS
'(-34.5d0 8.24d0 3.29d0 -8.93d0 34.12d0 -6.15d0 49.27d0 -13.49d0)))) '(-34.5d0 8.24d0 3.29d0 -8.93d0 34.12d0 -6.15d0 49.27d0 -13.49d0))))
(ABSOLUTE-SUM V1)))) (ABSOLUTE-SUM V1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 388.65997f0) (LIST 388.65997f0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((V1 (LET ((V1
(GRID:MAKE-FOREIGN-ARRAY (GRID:MAKE-FOREIGN-ARRAY
'(COMPLEX SINGLE-FLOAT) '(COMPLEX SINGLE-FLOAT)
:INITIAL-CONTENTS :INITIAL-CONTENTS
'(#C(-34.5f0 8.24f0) #C(3.29f0 -8.93f0) #C(34.12f0 -6.15f0) #C(49.27f0 -13.49f0) '(#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))))) #C(32.5f0 42.73f0) #C(-17.24f0 43.31f0) #C(-16.12f0 -8.25f0) #C(21.44f0 -49.08f0)))))
(ABSOLUTE-SUM V1)))) (ABSOLUTE-SUM V1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 388.65999999999997d0) (LIST 388.65999999999997d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((V1 (LET ((V1
#2m(#C(-34.5d0 8.24d0) #C(3.29d0 -8.93d0) #C(34.12d0 -6.15d0) (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(49.27d0 -13.49d0) #C(32.5d0 42.73d0) #C(-17.24d0 43.31d0)
#C(-16.12d0 -8.25d0) #C(21.44d0 -49.08d0)))) #C(-16.12d0 -8.25d0) #C(21.44d0 -49.08d0)))))
(ABSOLUTE-SUM V1))))) (ABSOLUTE-SUM V1)))))
...@@ -240,7 +240,10 @@ ...@@ -240,7 +240,10 @@
#(0.6713967071418024d0 0.5130161365618323d0 #(0.6713967071418024d0 0.5130161365618323d0
0.06500818287738516d0)) 0.06500818287738516d0))
(MULTIPLE-VALUE-LIST (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 (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST -0.1820221159534852d0 2.020851441225493d-15) (LIST -0.1820221159534852d0 2.020851441225493d-15)
(MULTIPLE-VALUE-LIST (cylindrical-bessel-Y 3.0d0 4.0d0))) (MULTIPLE-VALUE-LIST (cylindrical-bessel-Y 3.0d0 4.0d0)))
......
...@@ -19,31 +19,34 @@ ...@@ -19,31 +19,34 @@
(in-package :gsl) (in-package :gsl)
(LISP-UNIT:DEFINE-TEST DIRICHLET (LISP-UNIT:DEFINE-TEST DIRICHLET
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST (LIST
#(0.12448073544131681d0 0.19182353706734917d0 #(0.12448073544131681d0 0.19182353706734917d0
0.46054388544826397d0 0.22315184204307006d0)) 0.46054388544826397d0 0.22315184204307006d0))
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(let ((rng (make-random-number-generator +mt19937+ 0)) (let ((rng (make-random-number-generator +mt19937+ 0))
(alpha #m(1.0d0 2.0d0 3.0d0 4.0d0))) (alpha
(grid:copy-to (sample rng :dirichlet :alpha 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 (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(list 3.483648000000004d7) (list 3.483648000000004d7)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((ALPHA (LET ((ALPHA
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(1.0d0 2.0d0 3.0d0 4.0d0))) '(1.0d0 2.0d0 3.0d0 4.0d0)))
(THETA (THETA
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(1.0d0 2.0d0 3.0d0 4.0d0)))) '(1.0d0 2.0d0 3.0d0 4.0d0))))
(DIRICHLET-PDF ALPHA THETA)))) (DIRICHLET-PDF ALPHA THETA))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(list 17.366175671549307d0) (list 17.366175671549307d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(LET ((ALPHA (LET ((ALPHA
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(1.0d0 2.0d0 3.0d0 4.0d0))) '(1.0d0 2.0d0 3.0d0 4.0d0)))
(THETA (THETA
(GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS (GRID:MAKE-FOREIGN-ARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'(1.0d0 2.0d0 3.0d0 4.0d0)))) '(1.0d0 2.0d0 3.0d0 4.0d0))))
(DIRICHLET-LOG-PDF ALPHA THETA))))) (DIRICHLET-LOG-PDF ALPHA THETA)))))
...@@ -19,12 +19,11 @@ ...@@ -19,12 +19,11 @@
(in-package :gsl) (in-package :gsl)
(LISP-UNIT:DEFINE-TEST EIGENSYSTEMS (LISP-UNIT:DEFINE-TEST EIGENSYSTEMS
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST (LIST
#(13.819660112501051d0 36.180339887498945d0 40.0d0) #(13.819660112501051d0 36.180339887498945d0 40.0d0)
#2A((0.8506508083520399d0 -0.5257311121191337d0 0.0d0) #2A((0.8506508083520399d0 -0.5257311121191337d0 0.0d0)
(0.5257311121191337d0 0.8506508083520399d0 0.0d0) (0.5257311121191337d0 0.8506508083520399d0 0.0d0)
(0.0d0 0.0d0 1.0d0))) (0.0d0 0.0d0 1.0d0)))
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(EIGENVALUE-EIGENVECTORS-EXAMPLE)))) (EIGENVALUE-EIGENVECTORS-EXAMPLE))))
...@@ -50,8 +50,8 @@ ...@@ -50,8 +50,8 @@
'((#C(19.68 -5.55) #C(-8.82 25.37) #C(-30.58 31.67)) '((#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(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))))) (#C(29.36 -33.24) #C(-27.03 -41.67) #C(42.0 -20.81)))))
(S1 #C(-41.67 42.0)) (S1 #C(-41.67f0 42.0f0))
(S2 #C(42.0 -20.81))) (S2 #C(42.0f0 -20.81f0)))
(GRID:COPY-TO (GRID:COPY-TO
(MATRIX-PRODUCT-HERMITIAN M1 M2 M3 S1 S2))))) (MATRIX-PRODUCT-HERMITIAN M1 M2 M3 S1 S2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
...@@ -113,8 +113,8 @@ ...@@ -113,8 +113,8 @@
'(COMPLEX SINGLE-FLOAT) '(COMPLEX SINGLE-FLOAT)
:INITIAL-CONTENTS :INITIAL-CONTENTS
'(#C(-16.12 -8.25) #C(21.44 -49.08) #C(-39.66 -49.46)))) '(#C(-16.12 -8.25) #C(21.44 -49.08) #C(-39.66 -49.46))))
(S1 #C(-49.08 -39.66)) (S1 #C(-49.08f0 -39.66f0))
(S2 #C(-39.66 -49.46))) (S2 #C(-39.66f0 -49.46f0)))
(GRID:COPY-TO (GRID:COPY-TO
(MATRIX-PRODUCT-HERMITIAN M1 V1 V2 S1 S2))))) (MATRIX-PRODUCT-HERMITIAN M1 V1 V2 S1 S2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT::ASSERT-NUMERICAL-EQUAL
......
...@@ -19,33 +19,36 @@ ...@@ -19,33 +19,36 @@
(in-package :gsl) (in-package :gsl)
(LISP-UNIT:DEFINE-TEST MINIMIZATION-MULTI (LISP-UNIT:DEFINE-TEST MINIMIZATION-MULTI
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST 0.9920430849306285d0 1.9969168063253164d0 (LIST 0.9920430849306285d0 1.9969168063253164d0
30.000823246638923d0) 30.000823246638923d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-NO-DERIVATIVE (MULTIMIN-EXAMPLE-NO-DERIVATIVE
+SIMPLEX-NELDER-MEAD-ON2+ NIL))) +SIMPLEX-NELDER-MEAD-ON2+ NIL)))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL (let ((lisp-unit:*epsilon* (* 10 double-float-epsilon)))
(LIST 0.9999999999999997d0 2.0d0 30.0d0) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(MULTIPLE-VALUE-LIST (LIST 0.9999999999999997d0 2.0d0 30.0d0)
(MULTIMIN-EXAMPLE-DERIVATIVE (MULTIPLE-VALUE-LIST
+CONJUGATE-FLETCHER-REEVES+ NIL))) (MULTIMIN-EXAMPLE-DERIVATIVE
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL +CONJUGATE-FLETCHER-REEVES+ NIL))))
(LIST 0.9999999999999997d0 2.0d0 30.0d0) (let ((lisp-unit:*epsilon* (* 10 double-float-epsilon)))
(MULTIPLE-VALUE-LIST (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(MULTIMIN-EXAMPLE-DERIVATIVE +CONJUGATE-POLAK-RIBIERE+ (LIST 0.9999999999999997d0 2.0d0 30.0d0)
NIL))) (MULTIPLE-VALUE-LIST
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL (MULTIMIN-EXAMPLE-DERIVATIVE +CONJUGATE-POLAK-RIBIERE+
(LIST 0.9999999999999997d0 2.0d0 30.0d0) NIL))))
(MULTIPLE-VALUE-LIST (let ((lisp-unit:*epsilon* (* 10 double-float-epsilon)))
(MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS+ NIL))) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST 0.9999999999999997d0 2.0d0 30.0d0)
(LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0) (MULTIPLE-VALUE-LIST
(MULTIPLE-VALUE-LIST (MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS+ NIL))))
(MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS2+ NIL))) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL (LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0)
(LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0) (MULTIPLE-VALUE-LIST
(MULTIPLE-VALUE-LIST (MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS2+ NIL)))
(MULTIMIN-EXAMPLE-DERIVATIVE-SCALARS +VECTOR-BFGS2+ (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
NIL)))) (LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0)
(MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE-SCALARS +VECTOR-BFGS2+
NIL))))
...@@ -19,30 +19,32 @@ ...@@ -19,30 +19,32 @@