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
;; 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
......
;; 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))))
......
;; 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)))
;; 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)
......
;; 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)))))))
......
;; 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
......
;;; 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.
......
......@@ -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)))))
......@@ -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)))
......
......@@ -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)))))
......@@ -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))))
......@@ -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
......
......@@ -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))))
......@@ -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)))))
;; 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))))))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment