[cl-gsl-cvs] CVS update: cl-gsl/test/test-matrix.lisp
cl-gsl-cvs at common-lisp.net
cl-gsl-cvs at common-lisp.net
Thu Apr 28 02:42:20 UTC 2005
Update of /project/cl-gsl/cvsroot/cl-gsl/test
In directory common-lisp.net:/tmp/cvs-serv21499
Modified Files:
test-matrix.lisp
Log Message:
Added tests for newly added functions to matrix.lisp.
Date: Thu Apr 28 04:42:19 2005
Author: edenny
Index: cl-gsl/test/test-matrix.lisp
diff -u cl-gsl/test/test-matrix.lisp:1.1 cl-gsl/test/test-matrix.lisp:1.2
--- cl-gsl/test/test-matrix.lisp:1.1 Mon Apr 25 04:17:38 2005
+++ cl-gsl/test/test-matrix.lisp Thu Apr 28 04:42:19 2005
@@ -29,6 +29,12 @@
(-7.0d0 -8.0d0 -9.0d0 1.0d0 2.0d0)
(3.0d0 4.0d0 5.0d0 6.0d0 7.0d0))))
+(defconstant +vector-row-2-double-float+
+ (vector -2.0d0 -3.0d0 -4.0d0 -5.0d0 -6.0d0))
+
+(defconstant +vector-col-2-double-float+
+ (vector 3.0d0 8.0d0 -4.0d0 -9.0d0 5.0d0))
+
(defconstant +array-single-float+
(make-array '(5 5) :element-type 'single-float
:initial-contents '((1.0 2.0 3.0 4.0 5.0)
@@ -37,6 +43,12 @@
(-7.0 -8.0 -9.0 1.0 2.0)
(3.0 4.0 5.0 6.0 7.0))))
+(defconstant +vector-row-2-single-float+
+ (vector -2.0 -3.0 -4.0 -5.0 -6.0))
+
+(defconstant +vector-col-2-single-float+
+ (vector 3.0 8.0 -4.0 -9.0 5.0))
+
(defconstant +array-integer+
(make-array '(5 5) :element-type 'integer
:initial-contents '((1 2 3 4 5)
@@ -45,6 +57,12 @@
(-7 -8 -9 1 2)
(3 4 5 6 7))))
+(defconstant +vector-row-2-integer+
+ (vector -2 -3 -4 -5 -6))
+
+(defconstant +vector-col-2-integer+
+ (vector 3 8 -4 -9 5))
+
(defconstant +array-complex-double-float+
(make-array '(5 5) :element-type '(complex (double-float))
:initial-contents
@@ -64,6 +82,15 @@
(complex 5.0d0 6.0d0) (complex 6.0d0 7.0d0)
(complex 7.0d0 8.0d0)))))
+(defconstant +vector-row-2-complex-double-float+
+ (vector (complex -2.0d0 -3.0d0) (complex -3.0d0 -4.0d0)
+ (complex -4.0d0 -5.0d0) (complex -5.0d0 -6.0d0)
+ (complex -6.0d0 -7.0d0)))
+
+(defconstant +vector-col-2-complex-double-float+
+ (vector (complex 3.0d0 4.0d0) (complex 9.0d0 9.0d0) (complex -4.0d0 -5.0d0)
+ (complex -9.0d0 1.0d0) (complex 5.0d0 6.0d0)))
+
(defconstant +array-complex-single-float+
(make-array '(5 5) :element-type '(complex (single-float))
:initial-contents
@@ -83,6 +110,16 @@
(complex 5.0 6.0) (complex 6.0 7.0)
(complex 7.0 8.0)))))
+(defconstant +vector-row-2-complex-single-float+
+ (vector (complex -2.0 -3.0) (complex -3.0 -4.0) (complex -4.0 -5.0)
+ (complex -5.0 -6.0) (complex -6.0 -7.0)))
+
+(defconstant +vector-col-2-complex-single-float+
+ (vector (complex 3.0 4.0) (complex 9.0 9.0) (complex -4.0 -5.0)
+ (complex -9.0 1.0) (complex 5.0 6.0)))
+
+;; ----------------------------------------------------------------------
+
(deftest "make-matrix-double-float" :category +matrix+
:test-fn
#'(lambda ()
@@ -1306,3 +1343,726 @@
(gsl-array:with-matrix (m1 5 5 :element-type 'integer
:initial-contents +array-integer+)
(equalp '(-9 9) (gsl-array:min-max-values m1)))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "get-row-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (let ((v1 (gsl-array:get-row m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-row-2-double-float+)
+ (gsl-array:free v1))))))
+
+(deftest "get-row-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (let ((v1 (gsl-array:get-row m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-row-2-single-float+)
+ (gsl-array:free v1))))))
+
+(deftest "get-row-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:with-matrix-row (v1 m1 2)
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-row-2-integer+)))))
+
+
+(deftest "get-row-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (let ((v1 (gsl-array:get-row m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-row-2-complex-double-float+)
+ (gsl-array:free v1))))))
+
+(deftest "get-row-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (let ((v1 (gsl-array:get-row m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-row-2-complex-single-float+)
+ (gsl-array:free v1))))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "get-col-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (let ((v1 (gsl-array:get-col m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-col-2-double-float+)
+ (gsl-array:free v1))))))
+
+(deftest "get-col-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (let ((v1 (gsl-array:get-col m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-col-2-single-float+)
+ (gsl-array:free v1))))))
+
+(deftest "get-col-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:with-matrix-col (v1 m1 2)
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-col-2-integer+)))))
+
+
+(deftest "get-col-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (let ((v1 (gsl-array:get-col m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-col-2-complex-double-float+)
+ (gsl-array:free v1))))))
+
+(deftest "get-col-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (let ((v1 (gsl-array:get-col m1 2)))
+ (prog1
+ (equalp (gsl-array:gsl->lisp-vector v1)
+ +vector-col-2-complex-single-float+)
+ (gsl-array:free v1))))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "set-row-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (gsl-array:with-vector (v1 5 :element-type 'double-float
+ :initial-element 1.0d0)
+ (gsl-array:set-row m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= i 2)
+ (when (not (= (gsl-array:get-element m1 i j)
+ 1.0d0))
+ (setq ret nil))
+ (when (not (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ i j)))
+ (setq ret nil))))))))))
+
+(deftest "set-row-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (gsl-array:with-vector (v1 5 :element-type 'single-float
+ :initial-element 1.0)
+ (gsl-array:set-row m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= i 2)
+ (when (not (= (gsl-array:get-element m1 i j)
+ 1.0d0))
+ (setq ret nil))
+ (when (not (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ i j)))
+ (setq ret nil))))))))))
+
+(deftest "set-row-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:with-vector (v1 5 :element-type 'integer
+ :initial-element 1)
+ (gsl-array:set-row m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= i 2)
+ (when (not (= (gsl-array:get-element m1 i j)
+ 1.0d0))
+ (setq ret nil))
+ (when (not (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ i j)))
+ (setq ret nil))))))))))
+
+(deftest "set-row-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (gsl-array:with-vector
+ (v1 5 :element-type '(complex (double-float))
+ :initial-element (complex 1.0d0 1.0d0))
+ (gsl-array:set-row m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= i 2)
+ (unless (= (gsl-array:get-element m1 i j)
+ (complex 1.0d0 1.0d0))
+ (setq ret nil))
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "set-row-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (gsl-array:with-vector
+ (v1 5 :element-type '(complex (single-float))
+ :initial-element (complex 1.0 1.0))
+ (gsl-array:set-row m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= i 2)
+ (unless (= (gsl-array:get-element m1 i j)
+ (complex 1.0 1.0))
+ (setq ret nil))
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ i j))
+ (setq ret nil))))))))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "set-col-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (gsl-array:with-vector (v1 5 :element-type 'double-float
+ :initial-element 1.0d0)
+ (gsl-array:set-col m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= j 2)
+ (when (not (= (gsl-array:get-element m1 i j)
+ 1.0d0))
+ (setq ret nil))
+ (when (not (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ i j)))
+ (setq ret nil))))))))))
+
+(deftest "set-col-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (gsl-array:with-vector (v1 5 :element-type 'single-float
+ :initial-element 1.0)
+ (gsl-array:set-col m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= j 2)
+ (when (not (= (gsl-array:get-element m1 i j)
+ 1.0d0))
+ (setq ret nil))
+ (when (not (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ i j)))
+ (setq ret nil))))))))))
+
+(deftest "set-col-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:with-vector (v1 5 :element-type 'integer
+ :initial-element 1)
+ (gsl-array:set-col m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= j 2)
+ (when (not (= (gsl-array:get-element m1 i j)
+ 1.0d0))
+ (setq ret nil))
+ (when (not (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ i j)))
+ (setq ret nil))))))))))
+
+(deftest "set-col-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (gsl-array:with-vector
+ (v1 5 :element-type '(complex (double-float))
+ :initial-element (complex 1.0d0 1.0d0))
+ (gsl-array:set-col m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= j 2)
+ (unless (= (gsl-array:get-element m1 i j)
+ (complex 1.0d0 1.0d0))
+ (setq ret nil))
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "set-col-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (gsl-array:with-vector
+ (v1 5 :element-type '(complex (single-float))
+ :initial-element (complex 1.0 1.0))
+ (gsl-array:set-col m1 2 v1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (if (= j 2)
+ (unless (= (gsl-array:get-element m1 i j)
+ (complex 1.0 1.0))
+ (setq ret nil))
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ i j))
+ (setq ret nil))))))))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "swap-cols-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (gsl-array:swap-cols m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= j 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ i 3))
+ (setq ret nil)))
+ ((= j 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ i 1))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-cols-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (gsl-array:swap-cols m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= j 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ i 3))
+ (setq ret nil)))
+ ((= j 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ i 1))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-cols-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:swap-cols m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= j 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ i 3))
+ (setq ret nil)))
+ ((= j 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ i 1))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-cols-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (gsl-array:swap-cols m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= j 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ i 3))
+ (setq ret nil)))
+ ((= j 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ i 1))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-cols-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (gsl-array:swap-cols m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= j 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ i 3))
+ (setq ret nil)))
+ ((= j 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ i 1))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ i j))
+ (setq ret nil))))))))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "swap-rows-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (gsl-array:swap-rows m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= i 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ 3 j))
+ (setq ret nil)))
+ ((= i 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ 1 j))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-rows-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (gsl-array:swap-rows m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= i 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ 3 j))
+ (setq ret nil)))
+ ((= i 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ 1 j))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-rows-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:swap-rows m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= i 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ 3 j))
+ (setq ret nil)))
+ ((= i 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ 1 j))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-rows-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (gsl-array:swap-rows m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= i 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ 3 j))
+ (setq ret nil)))
+ ((= i 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ 1 j))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ i j))
+ (setq ret nil))))))))))
+
+(deftest "swap-rows-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (gsl-array:swap-rows m1 1 3)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (cond
+ ((= i 1)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ 3 j))
+ (setq ret nil)))
+ ((= i 3)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ 1 j))
+ (setq ret nil)))
+ (t
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ i j))
+ (setq ret nil))))))))))
+
+;; ----------------------------------------------------------------------
+
+;; TODO: find out what this function is supposed to do.
+;;
+;; (deftest "swap-rowcol-double-float" :category +matrix+
+;; :test-fn
+;; #'(lambda ()
+;; (gsl-array:with-matrix
+;; (m1 5 5 :element-type 'double-float
+;; :initial-contents +array-double-float+)
+;; (gsl-array:swap-rowcol m1 1 3)
+;; (let ((ret t))
+;; (dotimes (i 5 ret)
+;; (dotimes (j 5)
+;; (if (or (= i 1) (= j 3))
+;; (unless (= (gsl-array:get-element m1 i j)
+;; (aref +array-double-float+ j i))
+;; (setq ret nil))
+;; (unless (= (gsl-array:get-element m1 i j)
+;; (aref +array-double-float+ i j))
+;; (setq ret nil)))))))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "transpose-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (gsl-array:transpose m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-double-float+ j i))
+ (setq ret nil))))))))
+
+(deftest "transpose-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (gsl-array:transpose m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-single-float+ j i))
+ (setq ret nil))))))))
+
+(deftest "transpose-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:transpose m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-integer+ j i))
+ (setq ret nil))))))))
+
+(deftest "transpose-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (gsl-array:transpose m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-double-float+ j i))
+ (setq ret nil))))))))
+
+(deftest "transpose-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (gsl-array:transpose m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (aref +array-complex-single-float+ j i))
+ (setq ret nil))))))))
+
+;; ----------------------------------------------------------------------
+
+(deftest "copy-transpose-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type 'double-float
+ :initial-contents +array-double-float+)
+ (gsl-array:with-matrix (m2 5 5 :element-type 'double-float)
+ (gsl-array:copy-transpose m2 m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (gsl-array:get-element m2 j i))
+ (setq ret nil)))))))))
+
+(deftest "copy-transpose-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type 'single-float
+ :initial-contents +array-single-float+)
+ (gsl-array:with-copy-transpose (m2 m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (gsl-array:get-element m2 j i))
+ (setq ret nil)))))))))
+
+(deftest "copy-transpose-integer" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type 'integer
+ :initial-contents +array-integer+)
+ (gsl-array:with-copy-transpose (m2 m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (gsl-array:get-element m2 j i))
+ (setq ret nil)))))))))
+
+(deftest "copy-transpose-complex-double-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (double-float))
+ :initial-contents +array-complex-double-float+)
+ (gsl-array:with-copy-transpose (m2 m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (gsl-array:get-element m2 j i))
+ (setq ret nil)))))))))
+
+(deftest "copy-transpose-complex-single-float" :category +matrix+
+ :test-fn
+ #'(lambda ()
+ (gsl-array:with-matrix
+ (m1 5 5 :element-type '(complex (single-float))
+ :initial-contents +array-complex-single-float+)
+ (gsl-array:with-copy-transpose (m2 m1)
+ (let ((ret t))
+ (dotimes (i 5 ret)
+ (dotimes (j 5)
+ (unless (= (gsl-array:get-element m1 i j)
+ (gsl-array:get-element m2 j i))
+ (setq ret nil)))))))))
More information about the Cl-gsl-cvs
mailing list