Commit 913040d8 authored by Liam Healy's avatar Liam Healy

Use FSBV for functions taking complex scalars

The BLAS matrix-product functions now work on complex arrays using
FSBV, but there are no tests yet.  New tests vector-set-all and
matrix-set-all replace set-all tests with addition, and work for all
types including complex using FSBV.  Default optional argument marrays
are initialized to 0.  Polynomial evaluation with complex argument
uncommented, but not yet working.
parent 25a0259b
;; Tests of array functions
;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp
;; Time-stamp: <2009-04-11 22:33:59EDT array-tests.lisp>
;; Time-stamp: <2009-04-29 22:23:37EDT array-tests.lisp>
;; $Id: $
;;; Generate each file with #'write-test-to-file, e.g.
......@@ -15,17 +15,13 @@
;;;; Bulk operations
;;;;****************************************************************************
(generate-all-array-tests vector-set-all-add t
(let ((v1 (array-default 3 t))
(v2 (array-default 3)))
(set-all v1 (scalar-default))
(cl-array (elt+ v1 v2))))
(generate-all-array-tests vector-set-all t
(let ((v1 (array-default 3 t)))
(cl-array (set-all v1 (scalar-default)))))
(generate-all-array-tests matrix-set-all-add t
(let ((m1 (array-default '(3 3) t))
(m2 (array-default '(3 3))))
(set-all m1 (scalar-default))
(cl-array (elt+ m1 m2))))
(generate-all-array-tests matrix-set-all t
(let ((m1 (array-default '(3 3) t)))
(cl-array (set-all m1 (scalar-default)))))
(generate-all-array-tests vector-set-zero t
(let ((v1 (array-default 3)))
......@@ -59,6 +55,8 @@
;;;; Arithmetic operations
;;;;****************************************************************************
;;; In GSL versions >= 1.12, :no-complex can be changed to T.
(generate-all-array-tests vector-add :no-complex
(let ((v1 (array-default 3))
(v2 (array-default 3)))
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-03-16 19:02:05EDT gsll-tests.asd>
;; Time-stamp: <2009-04-29 22:25:14EDT gsll-tests.asd>
(asdf:defsystem "gsll-tests"
:name "gsll-tests"
......@@ -104,7 +104,7 @@
(:file "matrix-product-nonsquare")
(:file "matrix-product-symmetric")
(:file "matrix-product-triangular")
(:file "matrix-set-all-add")
(:file "matrix-set-all")
(:file "matrix-set-zero")
(:file "matrix-standard-deviation")
(:file "matrix-standard-deviation-with-fixed-mean")
......@@ -177,7 +177,7 @@
(:file "vector-add")
(:file "vector-mult")
(:file "vector-reverse")
(:file "vector-set-all-add")
(:file "vector-set-all")
(:file "vector-set-zero")
(:file "vector-standard-deviation")
(:file "vector-standard-deviation-with-fixed-mean")
......
;; Number types used by GSL functions, and specification conversion
;; Liam Healy 2008-12-31 21:06:34EST types.lisp
;; Time-stamp: <2009-01-13 22:00:26EST types.lisp>
;; Time-stamp: <2009-04-29 22:48:31EDT types.lisp>
;; $Id: $
(in-package :gsl)
......@@ -13,10 +13,12 @@
(cffi:foreign-type-size :long)
(8
(push :int64 *features*)
(cffi:defctype sizet :uint64))
(cffi:defctype sizet :uint64)
(fsbv:defsynonym sizet :uint64))
(4
(push :int32 *features*)
(cffi:defctype sizet :uint32))
(cffi:defctype sizet :uint32)
(fsbv:defsynonym sizet :uint64))
(t (error "Size of :long unrecognized")))
;;;;****************************************************************************
......
;; BLAS level 2, Matrix-vector operations
;; Liam Healy, Wed Apr 26 2006 - 21:08
;; Time-stamp: <2009-03-15 17:09:00EDT blas2.lisp>
;; Time-stamp: <2009-04-29 20:38:03EDT blas2.lisp>
;; $Id$
(in-package :gsl)
......@@ -15,14 +15,20 @@
"CBLAS_TRANSPOSE from /usr/include/gsl/gsl_cblas.h."
(:notrans 111) :trans :conjtrans)
(fsbv:defcenum-aux cblas-transpose)
(cffi:defcenum cblas-uplo
"/usr/include/gsl/gsl_cblas.h."
(:upper 121) :lower)
(fsbv:defcenum-aux cblas-uplo)
(cffi:defcenum cblas-diag
"/usr/include/gsl/gsl_cblas.h."
(:nonunit 131) :unit)
(fsbv:defcenum-aux cblas-diag)
;;;;****************************************************************************
;;;; Functions
;;;;****************************************************************************
......@@ -37,7 +43,9 @@
(defmfun matrix-product
((A matrix) (x vector)
&optional
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)))
(y (make-marray
element-type :dimensions (matrix-product-dimensions A x)
:initial-element 0))
(alpha 1) (beta 1) (TransA :notrans) TransB)
("gsl_blas_" :type "gemv")
((transa cblas-transpose) (alpha :element-c-type) ((mpointer A) :pointer)
......@@ -123,7 +131,8 @@
(defmfun matrix-product-symmetric
((A matrix) (x vector)
&optional
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)))
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)
:initial-element 0))
(alpha 1) (beta 1) (uplo :upper) (side :left))
("gsl_blas_" :type "symv")
((uplo cblas-uplo) (alpha :element-c-type) ((mpointer A) :pointer)
......@@ -151,7 +160,8 @@
(defmfun matrix-product-hermitian
((A matrix) (x vector)
&optional
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)))
(y (make-marray element-type :dimensions (matrix-product-dimensions A x)
:initial-element 0))
(alpha 1) (beta 1) (uplo :upper) (side :left))
;; This always signals an error because you can't pass a
;; struct in CFFI yet.
......
;; BLAS level 3, Matrix-matrix operations
;; Liam Healy, Wed Apr 26 2006 - 21:08
;; Time-stamp: <2009-03-15 17:15:40EDT blas3.lisp>
;; Time-stamp: <2009-04-29 20:36:48EDT blas3.lisp>
;; $Id$
(in-package :gsl)
......@@ -15,6 +15,8 @@
"/usr/include/gsl/gsl_cblas.h."
(:left 141) :right)
(fsbv:defcenum-aux cblas-side)
;;;;****************************************************************************
;;;; Functions
;;;;****************************************************************************
......@@ -22,7 +24,9 @@
(defmfun matrix-product
((A matrix) (B matrix)
&optional
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)))
(C (make-marray
element-type
:dimensions (matrix-product-dimensions A B) :initial-element 0))
(alpha 1) (beta 1) (TransA :notrans) (TransB :notrans))
("gsl_blas_" :type "gemm")
((TransA cblas-transpose) (TransB cblas-transpose)
......@@ -36,7 +40,8 @@
(defmfun matrix-product-symmetric
((A matrix) (B matrix)
&optional
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)))
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)
:initial-element 0))
(alpha 1) (beta 1) (uplo :upper) (side :left))
("gsl_blas_" :type "symm")
((side cblas-side) (uplo cblas-uplo) (alpha :element-c-type)
......@@ -50,7 +55,8 @@
(defmfun matrix-product-hermitian
((A matrix) (B matrix)
&optional
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)))
(C (make-marray element-type :dimensions (matrix-product-dimensions A B)
:initial-element 0))
(alpha 1) (beta 1) (uplo :upper) (side :left))
;; This always signals an error because you can't pass a
;; struct in CFFI yet.
......
;; Polynomials
;; Liam Healy, Tue Mar 21 2006 - 18:33
;; Time-stamp: <2009-04-27 21:25:42EDT polynomial.lisp>
;; Time-stamp: <2009-04-29 22:34:47EDT polynomial.lisp>
;; $Id$
(in-package :gsl)
......@@ -26,11 +26,10 @@
:documentation ; FDL
"Evaluate the polyonomial with coefficients at the point x.")
#|
;;; These won't work until we can take returned complex (structs).
(defmfun evaluate
((coefficients vector-double-float) (x complex)
&key &allow-other-keys)
&key)
"gsl_poly_complex_eval"
(((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet)
(x complex-double-c))
......@@ -43,7 +42,7 @@
(defmfun evaluate
((coefficients vector-complex-double-float) (x complex)
&key &allow-other-keys)
&key)
"gsl_complex_poly_complex_eval"
(((c-pointer coefficients) :pointer) ((dim0 coefficients) sizet)
(x complex-double-c))
......@@ -53,7 +52,6 @@
:c-return complex-double-c
:documentation ; FDL
"Evaluate the polyonomial with coefficients at the complex value x.")
|#
;;;;****************************************************************************
;;;; Divided Difference Representation of Polynomials
......
;; Regression test MATRIX-SET-ALL-ADD for GSLL, automatically generated
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST MATRIX-SET-ALL-ADD
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#2A((8.23 50.97 46.02)
(33.8 76.85 36.579998)
(92.0 29.24 75.229996)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3)))
(M2
(MAKE-MARRAY 'SINGLE-FLOAT :INITIAL-CONTENTS
'((-34.5 8.24 3.29)
(-8.93 34.12 -6.15)
(49.27 -13.49 32.5)))))
(SET-ALL M1 42.73)
(CL-ARRAY (ELT+ M1 M2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST
#2A((8.229999999999997d0 50.97d0 46.019999999999996d0)
(33.8d0 76.85d0 36.58d0)
(92.0d0 29.239999999999995d0
75.22999999999999d0)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3)))
(M2
(MAKE-MARRAY 'DOUBLE-FLOAT :INITIAL-CONTENTS
'((-34.5d0 8.24d0 3.29d0)
(-8.93d0 34.12d0 -6.15d0)
(49.27d0 -13.49d0 32.5d0)))))
(SET-ALL M1 42.73d0)
(CL-ARRAY (ELT+ M1 M2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-32 -36 103) (-59 84 22) (105 27 -101)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 8) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(SIGNED-BYTE 8) :INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))
(SET-ALL M1 32)
(CL-ARRAY (ELT+ M1 M2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((95 72 217) (144 191 168) (189 243 126)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 8) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(UNSIGNED-BYTE 8)
:INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98)))))
(SET-ALL M1 28)
(CL-ARRAY (ELT+ M1 M2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-32 -36 103) (-59 84 22) (105 27 155)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(SIGNED-BYTE 16)
:INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))
(SET-ALL M1 32)
(CL-ARRAY (ELT+ M1 M2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((95 72 217) (144 191 168) (189 243 126)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 16) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(UNSIGNED-BYTE 16)
:INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98)))))
(SET-ALL M1 28)
(CL-ARRAY (ELT+ M1 M2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-32 -36 103) (-59 84 22) (105 27 155)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(SIGNED-BYTE 32)
:INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))
(SET-ALL M1 32)
(CL-ARRAY (ELT+ M1 M2)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((95 72 217) (144 191 168) (189 243 126)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 32) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(UNSIGNED-BYTE 32)
:INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98)))))
(SET-ALL M1 28)
(CL-ARRAY (ELT+ M1 M2)))))
#+int64
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((-32 -36 103) (-59 84 22) (105 27 155)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(SIGNED-BYTE 64)
:INITIAL-CONTENTS
'((-64 -68 71) (-91 52 -10)
(73 -5 123)))))
(SET-ALL M1 32)
(CL-ARRAY (ELT+ M1 M2)))))
#+int64
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #2A((95 72 217) (144 191 168) (189 243 126)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 64) :DIMENSIONS
'(3 3)))
(M2
(MAKE-MARRAY '(UNSIGNED-BYTE 64)
:INITIAL-CONTENTS
'((67 44 189) (116 163 140)
(161 215 98)))))
(SET-ALL M1 28)
(CL-ARRAY (ELT+ M1 M2))))))
;; Regression test MATRIX-SET-ALL for GSLL, automatically generated
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST MATRIX-SET-ALL
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
#2A((-34.5 -34.5 -34.5)
(-34.5 -34.5 -34.5)
(-34.5 -34.5 -34.5)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY 'SINGLE-FLOAT :DIMENSIONS '(3 3))))
(CL-ARRAY (SET-ALL M1 -34.5)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
#2A((-34.5d0 -34.5d0 -34.5d0)
(-34.5d0 -34.5d0 -34.5d0)
(-34.5d0 -34.5d0 -34.5d0)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY 'DOUBLE-FLOAT :DIMENSIONS '(3 3))))
(CL-ARRAY (SET-ALL M1 -34.5d0)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
#2A((#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24))
(#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24))
(#C(-34.5 8.24) #C(-34.5 8.24) #C(-34.5 8.24))))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(COMPLEX SINGLE-FLOAT)
:DIMENSIONS '(3 3))))
(CL-ARRAY (SET-ALL M1 #C(-34.5 8.24))))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST
#2A((#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0)
#C(-34.5d0 8.24d0))
(#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0)
#C(-34.5d0 8.24d0))
(#C(-34.5d0 8.24d0) #C(-34.5d0 8.24d0)
#C(-34.5d0 8.24d0))))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT)
:DIMENSIONS '(3 3))))
(CL-ARRAY (SET-ALL M1 #C(-34.5d0 8.24d0))))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 8) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 -64)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 67 67) (67 67 67) (67 67 67)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 8) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 67)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 16) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 -64)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 67 67) (67 67 67) (67 67 67)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 16) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 67)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 32) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 -64)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 67 67) (67 67 67) (67 67 67)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 32) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 67)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((-64 -64 -64) (-64 -64 -64) (-64 -64 -64)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(SIGNED-BYTE 64) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 -64)))))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST #2A((67 67 67) (67 67 67) (67 67 67)))
(MULTIPLE-VALUE-LIST
(LET ((M1
(MAKE-MARRAY '(UNSIGNED-BYTE 64) :DIMENSIONS
'(3 3))))
(CL-ARRAY (SET-ALL M1 67))))))
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