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
......
;; 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,7 +372,9 @@
(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
......@@ -437,7 +439,9 @@
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
......@@ -481,7 +485,9 @@
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
......
;; 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,7 +405,9 @@
"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)
......@@ -460,7 +462,8 @@
(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)
......
......@@ -51,7 +51,10 @@
(LIST 388.65999999999997d0)
(MULTIPLE-VALUE-LIST
(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(-16.12d0 -8.25d0) #C(21.44d0 -49.08d0))))
#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)))
......
......@@ -25,7 +25,10 @@
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)))
(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)
......
......@@ -27,4 +27,3 @@
(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
......
......@@ -25,20 +25,23 @@
(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)))
+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)))
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)))
(MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS+ NIL))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0)
(MULTIPLE-VALUE-LIST
......
......@@ -23,7 +23,9 @@
(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)))
(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)
......
;; 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