From 03e762786082c8991b63cb365678df7c4004c75a Mon Sep 17 00:00:00 2001 From: Liam Healy <liam@thinkpad.local> Date: Mon, 29 Dec 2008 23:19:06 -0500 Subject: [PATCH] Specify :inputs and :outputs; more tests pass on non-native Several functions had incorrect :inputs and/or :outputs, which caused them to fail on non-native implementations. BLAS2 and BLAS3 tests did not properly initialize all arrays. Now 1187 tests pass in CCL. --- data/matrix.lisp | 8 +- init/generate-examples.lisp | 9 +- init/mobject.lisp | 6 +- linear-algebra/blas2.lisp | 36 +++---- linear-algebra/blas3.lisp | 42 ++++---- random/dirichlet.lisp | 7 +- random/discrete.lisp | 9 +- random/multinomial.lisp | 7 +- random/shuffling-sampling.lisp | 11 ++- solve-minimize-fit/roots-one.lisp | 5 +- special-functions/coulomb.lisp | 4 +- tests/matrix-product-hermitian.lisp | 62 ++++++++---- tests/matrix-product-symmetric.lisp | 70 ++++++++------ tests/matrix-product.lisp | 142 +++++++++++++++++----------- 14 files changed, 251 insertions(+), 167 deletions(-) diff --git a/data/matrix.lisp b/data/matrix.lisp index efd5056a..7e4e0714 100644 --- a/data/matrix.lisp +++ b/data/matrix.lisp @@ -1,6 +1,6 @@ ;; Matrices ;; Liam Healy 2008-04-15 21:57:52EDT matrix.lisp -;; Time-stamp: <2008-12-28 18:01:25EST matrix.lisp> +;; Time-stamp: <2008-12-29 20:33:38EST matrix.lisp> ;; $Id$ (in-package :gsl) @@ -73,7 +73,8 @@ (((mpointer matrix) :pointer) (i sizet) ((mpointer vector) :pointer)) :definition :generic :inputs (vector matrix) - :return (vector) ;setf should return + :outputs (matrix) + :return (vector) ;setf should return the quantity set :documentation ; FDL "Copy the elements of the vector into the jth column of the matrix. The length of the vector must be the same as the length of the column.") @@ -94,8 +95,9 @@ ("gsl_matrix" :type "_set_col") (((mpointer matrix) :pointer) (i sizet) ((mpointer vector) :pointer)) :definition :generic + :inputs (vector matrix) :outputs (matrix) - :return (vector) ;setf should return + :return (vector) ;setf should return the quantity set :documentation ; FDL "Copy the elements of the vector into the ith column of the matrix. The length of the vector must be the same as the length of the column.") diff --git a/init/generate-examples.lisp b/init/generate-examples.lisp index 70ff063f..82ad62f9 100644 --- a/init/generate-examples.lisp +++ b/init/generate-examples.lisp @@ -1,6 +1,6 @@ ;; Define examples. ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp -;; Time-stamp: <2008-12-28 15:27:28EST generate-examples.lisp> +;; Time-stamp: <2008-12-29 19:10:39EST generate-examples.lisp> ;; $Id: $ ;;; Define examples that can be displayed by users with the function @@ -37,8 +37,8 @@ in that category." (if name (getf *all-generated-tests* name) - (loop for (key value) on *all-generated-tests* by #'cddr - collect key))) + (loop for pr on *all-generated-tests* by #'cddr + collect (first pr)))) ;;;;**************************************************************************** ;;;; Data pool @@ -79,7 +79,8 @@ "Make a vector of the specified element type and length using the pool data for the type and starting at the specified point in the pool." (make-marray - length type + type + :dimensions length :initial-contents (make-list-from-pool type length starting))) diff --git a/init/mobject.lisp b/init/mobject.lisp index a38d0fab..53b58f69 100644 --- a/init/mobject.lisp +++ b/init/mobject.lisp @@ -1,6 +1,6 @@ ;; Definition of GSL objects and ways to use them. ;; Liam Healy, Sun Dec 3 2006 - 10:21 -;; Time-stamp: <2008-12-29 17:37:25EST mobject.lisp> +;; Time-stamp: <2008-12-29 22:33:11EST mobject.lisp> ;; $Id$ ;;; GSL objects are represented in GSLL as and instance of a 'mobject. @@ -23,7 +23,7 @@ "Define the class, the allocate, initialize-instance and reinitialize-instance methods, and the make-* function for the GSL object." ;; If prefix is a list, the first is the actual prefix, and the - ;; second is the name of the allocateor. I'm looking at you, + ;; second is the name of the allocator. I'm looking at you, ;; discrete-random. Grrr. ;; Argument 'initialize-suffix: string appended to prefix for form GSL function name ;; or a list of such a string and the c-return argument. @@ -45,6 +45,8 @@ (defmfun allocate ((object ,class) &key ,@cl-alloc-args) ,(if (listp prefix) (second prefix) (format nil "~a_alloc" prefix)) ,allocation-args + ,@(if (and (listp prefix) (third prefix)) + `(:inputs ,(third prefix))) :definition :method :c-return :pointer :index ,maker) diff --git a/linear-algebra/blas2.lisp b/linear-algebra/blas2.lisp index 6e16609e..5e03be4f 100644 --- a/linear-algebra/blas2.lisp +++ b/linear-algebra/blas2.lisp @@ -1,10 +1,12 @@ ;; BLAS level 2, Matrix-vector operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2008-12-26 12:23:21EST blas2.lisp> +;; Time-stamp: <2008-12-29 22:14:14EST blas2.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_blas.h + ;;;;**************************************************************************** ;;;; Options ;;;;**************************************************************************** @@ -299,39 +301,39 @@ (generate-all-array-tests matrix-product :float-complex (let ((m1 (array-default '(3 3))) - (v1 (array-default 3)) - (answer (array-default 3 t)) - (s1 (scalar-default)) - (s2 (scalar-default))) - (cl-array (matrix-product m1 v1 answer s1 s2)))) + (v1 (array-default 3)) + (v2 (array-default 3)) + (s1 (scalar-default)) + (s2 (scalar-default))) + (cl-array (matrix-product m1 v1 v2 s1 s2)))) (generate-all-array-tests matrix-product-triangular :float-complex (let ((m1 (array-default '(3 3))) - (v1 (array-default 3)) - (s1 (scalar-default))) + (v1 (array-default 3)) + (s1 (scalar-default))) (cl-array (matrix-product-triangular m1 v1 s1)))) (generate-all-array-tests inverse-matrix-product :float-complex (let ((m1 (array-default '(3 3))) - (v1 (array-default 3)) - (s1 (scalar-default))) + (v1 (array-default 3)) + (s1 (scalar-default))) (cl-array (inverse-matrix-product m1 v1 s1)))) (generate-all-array-tests matrix-product-symmetric :float (let ((m1 (array-default '(3 3))) (v1 (array-default 3)) - (answer (array-default 3 t)) + (v3 (array-default 3)) (s1 (scalar-default)) (s2 (scalar-default))) - (cl-array (matrix-product-symmetric m1 v1 answer s1 s2)))) + (cl-array (matrix-product-symmetric m1 v1 v3 s1 s2)))) (generate-all-array-tests matrix-product-hermitian :complex (let ((m1 (array-default '(3 3))) - (v1 (array-default 3)) - (answer (array-default 3 t)) - (s1 (scalar-default)) - (s2 (scalar-default))) - (cl-array (matrix-product-hermitian m1 v1 answer s1 s2)))) + (v1 (array-default 3)) + (v2 (array-default 3)) + (s1 (scalar-default)) + (s2 (scalar-default))) + (cl-array (matrix-product-hermitian m1 v1 v2 s1 s2)))) #| ;;; Error, needs to be tracked down diff --git a/linear-algebra/blas3.lisp b/linear-algebra/blas3.lisp index 808c4311..b04a4282 100644 --- a/linear-algebra/blas3.lisp +++ b/linear-algebra/blas3.lisp @@ -1,10 +1,12 @@ ;; BLAS level 3, Matrix-matrix operations ;; Liam Healy, Wed Apr 26 2006 - 21:08 -;; Time-stamp: <2008-12-26 12:23:21EST blas3.lisp> +;; Time-stamp: <2008-12-29 21:57:02EST blas3.lisp> ;; $Id$ (in-package :gsl) +;;; /usr/include/gsl/gsl_blas.h + ;;;;**************************************************************************** ;;;; Options ;;;;**************************************************************************** @@ -139,36 +141,36 @@ (generate-all-array-tests matrix-product :float-complex (let ((m1 (array-default '(3 3))) - (m2 (array-default '(3 3))) - (answer (array-default '(3 3) t)) - (s1 (scalar-default)) - (s2 (scalar-default))) - (cl-array (matrix-product m1 m2 answer s1 s2)))) + (m2 (array-default '(3 3))) + (m3 (array-default '(3 3))) + (s1 (scalar-default)) + (s2 (scalar-default))) + (cl-array (matrix-product m1 m2 m3 s1 s2)))) (generate-all-array-tests matrix-product-triangular :float-complex (let ((m1 (array-default '(3 3))) - (m2 (array-default '(3 3))) - (s1 (scalar-default))) + (m2 (array-default '(3 3))) + (s1 (scalar-default))) (cl-array (matrix-product-triangular m1 m2 s1)))) (generate-all-array-tests inverse-matrix-product :float-complex (let ((m1 (array-default '(3 3))) - (m2 (array-default '(3 3))) - (s1 (scalar-default))) + (m2 (array-default '(3 3))) + (s1 (scalar-default))) (cl-array (inverse-matrix-product m1 m2 s1)))) (generate-all-array-tests matrix-product-symmetric :float (let ((m1 (array-default '(3 3))) - (m2 (array-default '(3 3))) - (answer (array-default '(3 3) t)) - (s1 (scalar-default)) - (s2 (scalar-default))) - (cl-array (matrix-product-symmetric m1 m2 answer s1 s2)))) + (m2 (array-default '(3 3))) + (m3 (array-default '(3 3))) + (s1 (scalar-default)) + (s2 (scalar-default))) + (cl-array (matrix-product-symmetric m1 m2 m3 s1 s2)))) (generate-all-array-tests matrix-product-hermitian :complex (let ((m1 (array-default '(3 3))) - (m2 (array-default '(3 3))) - (answer (array-default '(3 3) t)) - (s1 (scalar-default)) - (s2 (scalar-default))) - (cl-array (matrix-product-hermitian m1 m2 answer s1 s2)))) + (m2 (array-default '(3 3))) + (m3 (array-default '(3 3))) + (s1 (scalar-default)) + (s2 (scalar-default))) + (cl-array (matrix-product-hermitian m1 m2 m3 s1 s2)))) diff --git a/random/dirichlet.lisp b/random/dirichlet.lisp index 4a10909e..13439027 100644 --- a/random/dirichlet.lisp +++ b/random/dirichlet.lisp @@ -1,6 +1,6 @@ ;; Dirichlet distribution ;; Liam Healy, Sun Oct 29 2006 -;; Time-stamp: <2008-12-26 19:50:49EST dirichlet.lisp> +;; Time-stamp: <2008-12-29 22:22:57EST dirichlet.lisp> ;; $Id$ (in-package :gsl) @@ -14,7 +14,10 @@ ((c-pointer alpha) :pointer) ;; theta had better be at least as long as alpha, or they'll be trouble ((c-pointer theta) :pointer)) + :inputs (alpha) + :outputs (theta) :c-return :void + :return (theta) :documentation ; FDL "An array of K=(length alpha) random variates from a Dirichlet distribution of order K-1. The distribution function is @@ -37,6 +40,7 @@ ((c-pointer alpha) :pointer) ;; theta had better be at least as long as alpha, or they'll be trouble ((c-pointer theta) :pointer)) + :inputs (alpha theta) :c-return :double :documentation ; FDL "The probability density p(\theta_1, ... , \theta_K) @@ -49,6 +53,7 @@ ((c-pointer alpha) :pointer) ;; theta had better be at least as long as alpha, or they'll be trouble ((c-pointer theta) :pointer)) + :inputs (alpha theta) :c-return :double :documentation ; FDL "The logarithm of the probability density diff --git a/random/discrete.lisp b/random/discrete.lisp index 8e0891d4..e61fe71c 100644 --- a/random/discrete.lisp +++ b/random/discrete.lisp @@ -1,6 +1,6 @@ ;; Discrete random variables ;; Liam Healy, Sat Nov 11 2006 - 21:51 -;; Time-stamp: <2008-12-27 10:33:36EST discrete.lisp> +;; Time-stamp: <2008-12-29 22:33:10EST discrete.lisp> ;; $Id$ (in-package :gsl) @@ -8,7 +8,7 @@ ;;; /usr/include/gsl/gsl_randist.h (defmobject discrete-random - ("gsl_ran_discrete" "gsl_ran_discrete_preproc") + ("gsl_ran_discrete" "gsl_ran_discrete_preproc" (probabilities)) (((dim0 probabilities) sizet) ((c-pointer probabilities) :pointer)) "lookup table for the discrete random number generator" ; FDL "Make a structure that contains the lookup @@ -22,9 +22,8 @@ "gsl_ran_discrete" (((mpointer generator) :pointer) ((mpointer table) :pointer)) :c-return sizet - :documentation ; FDL - "Generate discrete random numbers after running #'discrete-preprocess; - the argument 'table is the value returned by #'discrete-preprocess.") + :documentation + "Generate discrete random numbers.") (defmfun discrete-pdf (k table) "gsl_ran_discrete_pdf" diff --git a/random/multinomial.lisp b/random/multinomial.lisp index 88f403f7..2630eefd 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: <2008-12-26 19:50:51EST multinomial.lisp> +;; Time-stamp: <2008-12-29 20:56:56EST multinomial.lisp> ;; $Id$ (in-package :gsl) @@ -15,6 +15,9 @@ ((c-pointer p) :pointer) ;; technically, n should be a uint array, but integers work ((c-pointer n) :pointer)) + :inputs (p) + :outputs (n) + :return (n) :c-return :void :documentation ; FDL "Returns an array n of K random variates from a @@ -34,6 +37,7 @@ (defmfun multinomial-pdf (p n) "gsl_ran_multinomial_pdf" (((dim0 p) sizet) ((c-pointer p) :pointer) ((c-pointer n) :pointer)) + :inputs (p n) :c-return :double :documentation ; FDL "Compute the probability P(n_1, n_2, ..., n_K) @@ -43,6 +47,7 @@ (defmfun multinomial-log-pdf (p n) "gsl_ran_multinomial_lnpdf" (((dim0 p) sizet) ((c-pointer p) :pointer) ((c-pointer n) :pointer)) + :inputs (p n) :c-return :double :documentation ; FDL "Compute the natural logarithm of the probability P(n_1, n_2, ..., n_K) diff --git a/random/shuffling-sampling.lisp b/random/shuffling-sampling.lisp index ae452b6b..32848e5c 100644 --- a/random/shuffling-sampling.lisp +++ b/random/shuffling-sampling.lisp @@ -1,6 +1,6 @@ ;; Shuffling and sampling ;; Liam Healy, Sat Dec 2 2006 - 18:40 -;; Time-stamp: <2008-12-26 19:51:20EST shuffling-sampling.lisp> +;; Time-stamp: <2008-12-29 19:36:17EST shuffling-sampling.lisp> ;; $Id$ (in-package :gsl) @@ -11,6 +11,8 @@ "gsl_ran_shuffle" (((mpointer generator) :pointer) ((c-pointer base) :pointer) ((dim0 base) sizet) ((element-size base) sizet)) + :inputs (base) + :outputs (base) :c-return :void :documentation ; FDL "Randomly shuffle the order of n objects, each of @@ -25,9 +27,8 @@ (((mpointer generator) :pointer) ((c-pointer dest) :pointer) ((dim0 dest) sizet) ((c-pointer src) :pointer) ((dim0 src) sizet) ((element-size src) sizet)) - ;; This is described in the GSL docs as returning int, but it does - ;; not say what the return value means. Therefore, we ignore it. - :c-return :void + :inputs (dest src) + :outputs (dest) :documentation ; FDL "Fill the array dest[k] with k objects taken randomly from the n elements of the array @@ -47,6 +48,8 @@ (((mpointer generator) :pointer) ((c-pointer dest) :pointer) ((dim0 dest) sizet) ((c-pointer src) :pointer) ((dim0 src) sizet) ((element-size src) sizet)) + :inputs (dest src) + :outputs (dest) :c-return :void :documentation "Like #'choose-random, but samples k items diff --git a/solve-minimize-fit/roots-one.lisp b/solve-minimize-fit/roots-one.lisp index b38940a5..cfea5042 100644 --- a/solve-minimize-fit/roots-one.lisp +++ b/solve-minimize-fit/roots-one.lisp @@ -1,6 +1,6 @@ ;; One-dimensional root solver. ;; Liam Healy -;; Time-stamp: <2008-12-26 18:31:13EST roots-one.lisp> +;; Time-stamp: <2008-12-29 19:16:52EST roots-one.lisp> ;; $Id$ (in-package :gsl) @@ -353,9 +353,8 @@ *newton-fdfsolver* quadratic-df initial))) (format t "~&iter ~6t ~8troot ~22terr ~34terr(est)") (loop for iter from 0 - for itres = (iterate-fdfsolver solver) for oldroot = initial then root - for root = (fdfsolver-root solver) + for root = (progn (iterate-fdfsolver solver) (fdfsolver-root solver)) while (and (< iter max-iter) (not (root-test-delta root oldroot 0.0d0 1.0d-5))) do diff --git a/special-functions/coulomb.lisp b/special-functions/coulomb.lisp index ae95a9bd..795e88e1 100644 --- a/special-functions/coulomb.lisp +++ b/special-functions/coulomb.lisp @@ -1,6 +1,6 @@ ;; Coulumb functions ;; Liam Healy, Sat Mar 18 2006 - 23:23 -;; Time-stamp: <2008-12-26 12:18:56EST coulomb.lisp> +;; Time-stamp: <2008-12-29 20:49:45EST coulomb.lisp> ;; $Id$ (in-package :gsl) @@ -64,6 +64,7 @@ ((L-min :double) ((1- (dim0 fc-array)) :int) (eta :double) (x :double) ((c-pointer fc-array) :pointer) ((c-pointer gc-array) :pointer) (F-exponent :double) (G-exponent :double)) + :outputs (fc-array gc-array) :return (fc-array gc-array (dcref F-exponent) (dcref G-exponent)) :documentation ; FDL "The functions F_L(\eta,x), @@ -77,6 +78,7 @@ ((c-pointer fc-array) :pointer) ((c-pointer fcp-array) :pointer) ((c-pointer gc-array) :pointer) ((c-pointer gcp-array) :pointer) (F-exponent :double) (G-exponent :double)) + :outputs (fc-array fcp-array gc-array gcp-array) :return (fc-array fcp-array gc-array gcp-array (dcref F-exponent) (dcref G-exponent)) diff --git a/tests/matrix-product-hermitian.lisp b/tests/matrix-product-hermitian.lisp index 485ccfba..1a7946c0 100644 --- a/tests/matrix-product-hermitian.lisp +++ b/tests/matrix-product-hermitian.lisp @@ -25,16 +25,23 @@ -49.08 -39.66 -49.46) (-49.08 -39.66 -49.46 19.68 -5.55 -8.82)))) - (ANSWER + (M3 (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) - :DIMENSIONS '(3 3))) - (S1 #C(19.68 -5.55)) - (S2 #C(-5.55 -8.82))) + :INITIAL-CONTENTS + '((19.68 -5.55 -8.82 + 25.37 -30.58 31.67) + (25.37 -30.58 31.67 + 29.36 -33.24 -27.03) + (29.36 -33.24 -27.03 + -41.67 42.0 + -20.81)))) + (S1 #C(-41.67 42.0)) + (S2 #C(42.0 -20.81))) (CL-ARRAY (MATRIX-PRODUCT-HERMITIAN M1 M2 - ANSWER + M3 S1 S2)))) (LISP-UNIT:ASSERT-ERROR 'SIMPLE-ERROR @@ -64,16 +71,25 @@ (-49.08d0 -39.66d0 -49.46d0 19.68d0 -5.55d0 -8.82d0)))) - (ANSWER + (M3 (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) - :DIMENSIONS '(3 3))) - (S1 #C(19.68d0 -5.55d0)) - (S2 #C(-5.55d0 -8.82d0))) + :INITIAL-CONTENTS + '((19.68d0 -5.55d0 + -8.82d0 25.37d0 + -30.58d0 31.67d0) + (25.37d0 -30.58d0 + 31.67d0 29.36d0 + -33.24d0 -27.03d0) + (29.36d0 -33.24d0 + -27.03d0 -41.67d0 + 42.0d0 -20.81d0)))) + (S1 #C(-41.67d0 42.0d0)) + (S2 #C(42.0d0 -20.81d0))) (CL-ARRAY (MATRIX-PRODUCT-HERMITIAN M1 M2 - ANSWER + M3 S1 S2)))) (LISP-UNIT:ASSERT-ERROR 'SIMPLE-ERROR @@ -94,16 +110,19 @@ :INITIAL-CONTENTS '(42.73 -17.24 43.31 -16.12 -8.25 21.44))) - (ANSWER + (V2 (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) - :DIMENSIONS '3)) - (S1 #C(-16.12 -8.25)) - (S2 #C(-8.25 21.44))) + :INITIAL-CONTENTS + '(-16.12 -8.25 21.44 + -49.08 -39.66 + -49.46))) + (S1 #C(-49.08 -39.66)) + (S2 #C(-39.66 -49.46))) (CL-ARRAY (MATRIX-PRODUCT-HERMITIAN M1 V1 - ANSWER + V2 S1 S2)))) (LISP-UNIT:ASSERT-ERROR 'SIMPLE-ERROR @@ -127,16 +146,19 @@ '(42.73d0 -17.24d0 43.31d0 -16.12d0 -8.25d0 21.44d0))) - (ANSWER + (V2 (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) - :DIMENSIONS '3)) - (S1 #C(-16.12d0 -8.25d0)) - (S2 #C(-8.25d0 21.44d0))) + :INITIAL-CONTENTS + '(-16.12d0 -8.25d0 + 21.44d0 -49.08d0 + -39.66d0 -49.46d0))) + (S1 #C(-49.08d0 -39.66d0)) + (S2 #C(-39.66d0 -49.46d0))) (CL-ARRAY (MATRIX-PRODUCT-HERMITIAN M1 V1 - ANSWER + V2 S1 S2))))) diff --git a/tests/matrix-product-symmetric.lisp b/tests/matrix-product-symmetric.lisp index 61d44e8f..148b58fd 100644 --- a/tests/matrix-product-symmetric.lisp +++ b/tests/matrix-product-symmetric.lisp @@ -5,9 +5,9 @@ (LISP-UNIT:DEFINE-TEST MATRIX-PRODUCT-SYMMETRIC (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST - #2A((-34803.824 7799.5503 -29131.375) - (2045.2012 -3535.288 27406.096) - (-26673.887 -25484.264 -31425.34))) + #2A((74519.41 -16747.695 61311.69) + (-3264.9219 6201.1797 -56698.92) + (57711.813 52563.74 65404.063))) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS @@ -19,19 +19,23 @@ '((42.73 -17.24 43.31) (-16.12 -8.25 21.44) (-49.08 -39.66 -49.46)))) - (ANSWER - (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3))) - (S1 19.68) - (S2 -5.55)) + (M3 + (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS + '((19.68 -5.55 -8.82) + (25.37 -30.58 31.67) + (29.36 -33.24 -27.03)))) + (S1 -41.67) + (S2 42.0)) (CL-ARRAY - (MATRIX-PRODUCT-SYMMETRIC M1 M2 ANSWER S1 S2))))) + (MATRIX-PRODUCT-SYMMETRIC M1 M2 M3 S1 S2))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST - #2A((-34803.82416d0 7799.550048d0 -29131.375104d0) - (2045.2007039999999d0 -3535.2876479999995d0 - 27406.096416d0) - (-26673.884303999996d0 -25484.263728d0 - -31425.340848d0))) + #2A((74519.41329d0 -16747.696062d0 + 61311.694176000005d0) + (-3264.923076000001d0 6201.180462000002d0 + -56698.92695400001d0) + (57711.81710100001d0 52563.740607d0 + 65404.066887d0))) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS @@ -43,14 +47,17 @@ '((42.73d0 -17.24d0 43.31d0) (-16.12d0 -8.25d0 21.44d0) (-49.08d0 -39.66d0 -49.46d0)))) - (ANSWER - (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3))) - (S1 19.68d0) - (S2 -5.55d0)) + (M3 + (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '((19.68d0 -5.55d0 -8.82d0) + (25.37d0 -30.58d0 31.67d0) + (29.36d0 -33.24d0 -27.03d0)))) + (S1 -41.67d0) + (S2 42.0d0)) (CL-ARRAY - (MATRIX-PRODUCT-SYMMETRIC M1 M2 ANSWER S1 S2))))) + (MATRIX-PRODUCT-SYMMETRIC M1 M2 M3 S1 S2))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(23756.895 8100.1406 -26665.428)) + (LIST #(72971.1 24989.41 -82037.61)) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS @@ -60,15 +67,17 @@ (V1 (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS '(42.73 -17.24 43.31))) - (ANSWER - (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '3)) - (S1 -16.12) - (S2 -8.25)) + (V3 + (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS + '(-16.12 -8.25 21.44))) + (S1 -49.08) + (S2 -39.66)) (CL-ARRAY - (MATRIX-PRODUCT-SYMMETRIC M1 V1 ANSWER S1 S2))))) + (MATRIX-PRODUCT-SYMMETRIC M1 V1 V3 S1 S2))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST - #(23756.893524d0 8100.140412d0 -26665.425124000005d0)) + #(72971.10171599999d0 24989.409107999996d0 + -82037.597316d0)) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS @@ -78,10 +87,11 @@ (V1 (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS '(42.73d0 -17.24d0 43.31d0))) - (ANSWER - (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '3)) - (S1 -16.12d0) - (S2 -8.25d0)) + (V3 + (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(-16.12d0 -8.25d0 21.44d0))) + (S1 -49.08d0) + (S2 -39.66d0)) (CL-ARRAY - (MATRIX-PRODUCT-SYMMETRIC M1 V1 ANSWER S1 S2)))))) + (MATRIX-PRODUCT-SYMMETRIC M1 V1 V3 S1 S2)))))) diff --git a/tests/matrix-product.lisp b/tests/matrix-product.lisp index 6d77652e..3655ee2a 100644 --- a/tests/matrix-product.lisp +++ b/tests/matrix-product.lisp @@ -5,9 +5,9 @@ (LISP-UNIT:DEFINE-TEST MATRIX-PRODUCT (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST - #2A((-34803.824 7799.55 -29131.377) - (-12393.505 2290.2053 12771.404) - (14320.465 -39892.78 4668.254))) + #2A((74519.41 -16747.695 61311.69) + (27307.273 -6133.5903 -25711.75) + (-29088.719 83072.016 -11019.719))) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS @@ -19,19 +19,22 @@ '((42.73 -17.24 43.31) (-16.12 -8.25 21.44) (-49.08 -39.66 -49.46)))) - (ANSWER - (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3))) - (S1 19.68) - (S2 -5.55)) - (CL-ARRAY (MATRIX-PRODUCT M1 M2 ANSWER S1 S2))))) + (M3 + (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS + '((19.68 -5.55 -8.82) + (25.37 -30.58 31.67) + (29.36 -33.24 -27.03)))) + (S1 -41.67) + (S2 42.0)) + (CL-ARRAY (MATRIX-PRODUCT M1 M2 M3 S1 S2))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST - #2A((-34803.824160000004d0 7799.550047999999d0 - -29131.375104000002d0) - (-12393.505583999999d0 2290.2048959999997d0 - 12771.40488d0) - (14320.464911999996d0 -39892.782864d0 - 4668.255407999997d0))) + #2A((74519.41329d0 -16747.696061999995d0 + 61311.694176d0) + (27307.276670999996d0 -6133.589574d0 + -25711.752344999997d0) + (-29088.718053000033d0 83072.022741d0 + -11019.721527000016d0))) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS @@ -43,11 +46,14 @@ '((42.73d0 -17.24d0 43.31d0) (-16.12d0 -8.25d0 21.44d0) (-49.08d0 -39.66d0 -49.46d0)))) - (ANSWER - (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3))) - (S1 19.68d0) - (S2 -5.55d0)) - (CL-ARRAY (MATRIX-PRODUCT M1 M2 ANSWER S1 S2))))) + (M3 + (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '((19.68d0 -5.55d0 -8.82d0) + (25.37d0 -30.58d0 31.67d0) + (29.36d0 -33.24d0 -27.03d0)))) + (S1 -41.67d0) + (S2 42.0d0)) + (CL-ARRAY (MATRIX-PRODUCT M1 M2 M3 S1 S2))))) (LISP-UNIT:ASSERT-ERROR 'SIMPLE-ERROR (LET ((M1 (MAKE-MARRAY @@ -70,15 +76,22 @@ -49.08 -39.66 -49.46) (-49.08 -39.66 -49.46 19.68 -5.55 -8.82)))) - (ANSWER + (M3 (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) - :DIMENSIONS '(3 3))) - (S1 #C(19.68 -5.55)) - (S2 #C(-5.55 -8.82))) + :INITIAL-CONTENTS + '((19.68 -5.55 -8.82 + 25.37 -30.58 31.67) + (25.37 -30.58 31.67 + 29.36 -33.24 -27.03) + (29.36 -33.24 -27.03 + -41.67 42.0 + -20.81)))) + (S1 #C(-41.67 42.0)) + (S2 #C(42.0 -20.81))) (CL-ARRAY - (MATRIX-PRODUCT M1 M2 ANSWER - S1 S2)))) + (MATRIX-PRODUCT M1 M2 M3 S1 + S2)))) (LISP-UNIT:ASSERT-ERROR 'SIMPLE-ERROR (LET ((M1 (MAKE-MARRAY @@ -106,17 +119,26 @@ (-49.08d0 -39.66d0 -49.46d0 19.68d0 -5.55d0 -8.82d0)))) - (ANSWER + (M3 (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) - :DIMENSIONS '(3 3))) - (S1 #C(19.68d0 -5.55d0)) - (S2 #C(-5.55d0 -8.82d0))) + :INITIAL-CONTENTS + '((19.68d0 -5.55d0 + -8.82d0 25.37d0 + -30.58d0 31.67d0) + (25.37d0 -30.58d0 + 31.67d0 29.36d0 + -33.24d0 -27.03d0) + (29.36d0 -33.24d0 + -27.03d0 -41.67d0 + 42.0d0 -20.81d0)))) + (S1 #C(-41.67d0 42.0d0)) + (S2 #C(42.0d0 -20.81d0))) (CL-ARRAY - (MATRIX-PRODUCT M1 M2 ANSWER - S1 S2)))) + (MATRIX-PRODUCT M1 M2 M3 S1 + S2)))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL - (LIST #(23756.895 19926.967 -60376.652)) + (LIST #(72971.1 60998.137 -184676.98)) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS @@ -126,15 +148,16 @@ (V1 (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS '(42.73 -17.24 43.31))) - (ANSWER - (MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '3)) - (S1 -16.12) - (S2 -8.25)) - (CL-ARRAY (MATRIX-PRODUCT M1 V1 ANSWER S1 S2))))) + (V2 + (MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS + '(-16.12 -8.25 21.44))) + (S1 -49.08) + (S2 -39.66)) + (CL-ARRAY (MATRIX-PRODUCT M1 V1 V2 S1 S2))))) (LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST - #(23756.893524000003d0 19926.966904d0 - -60376.649164d0)) + #(72971.10171599999d0 60998.13393599999d0 + -184676.981676d0)) (MULTIPLE-VALUE-LIST (LET ((M1 (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS @@ -144,11 +167,12 @@ (V1 (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS '(42.73d0 -17.24d0 43.31d0))) - (ANSWER - (MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '3)) - (S1 -16.12d0) - (S2 -8.25d0)) - (CL-ARRAY (MATRIX-PRODUCT M1 V1 ANSWER S1 S2))))) + (V2 + (MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS + '(-16.12d0 -8.25d0 21.44d0))) + (S1 -49.08d0) + (S2 -39.66d0)) + (CL-ARRAY (MATRIX-PRODUCT M1 V1 V2 S1 S2))))) (LISP-UNIT:ASSERT-ERROR 'SIMPLE-ERROR (LET ((M1 (MAKE-MARRAY @@ -167,15 +191,18 @@ :INITIAL-CONTENTS '(42.73 -17.24 43.31 -16.12 -8.25 21.44))) - (ANSWER + (V2 (MAKE-MARRAY '(COMPLEX SINGLE-FLOAT) - :DIMENSIONS '3)) - (S1 #C(-16.12 -8.25)) - (S2 #C(-8.25 21.44))) + :INITIAL-CONTENTS + '(-16.12 -8.25 21.44 + -49.08 -39.66 + -49.46))) + (S1 #C(-49.08 -39.66)) + (S2 #C(-39.66 -49.46))) (CL-ARRAY - (MATRIX-PRODUCT M1 V1 ANSWER - S1 S2)))) + (MATRIX-PRODUCT M1 V1 V2 S1 + S2)))) (LISP-UNIT:ASSERT-ERROR 'SIMPLE-ERROR (LET ((M1 (MAKE-MARRAY @@ -197,13 +224,16 @@ '(42.73d0 -17.24d0 43.31d0 -16.12d0 -8.25d0 21.44d0))) - (ANSWER + (V2 (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) - :DIMENSIONS '3)) - (S1 #C(-16.12d0 -8.25d0)) - (S2 #C(-8.25d0 21.44d0))) + :INITIAL-CONTENTS + '(-16.12d0 -8.25d0 + 21.44d0 -49.08d0 + -39.66d0 -49.46d0))) + (S1 #C(-49.08d0 -39.66d0)) + (S2 #C(-39.66d0 -49.46d0))) (CL-ARRAY - (MATRIX-PRODUCT M1 V1 ANSWER - S1 S2))))) + (MATRIX-PRODUCT M1 V1 V2 S1 + S2))))) -- GitLab