April 2005 - cl-gsl-cvs@common-lisp.net - mailman3.common-lisp.net

[cl-gsl-cvs] CVS update: cl-gsl/cl-gsl.asd
by cl-gsl-cvs＠common-lisp.net 30 Apr '05

30 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4087 Modified Files: cl-gsl.asd Log Message: Added permutation to the defsystem. Date: Sun May 1 00:33:10 2005 Author: edenny Index: cl-gsl/cl-gsl.asd diff -u cl-gsl/cl-gsl.asd:1.2 cl-gsl/cl-gsl.asd:1.3 --- cl-gsl/cl-gsl.asd:1.2 Mon Apr 18 02:47:42 2005 +++ cl-gsl/cl-gsl.asd Sun May 1 00:33:10 2005 @@ -42,4 +42,5 @@ (:file "sf" :depends-on ("util" "ffi")) (:file "vector" :depends-on ("util" "ffi")) (:file "matrix" :depends-on ("util" "ffi")) + (:file "permutation" :depends-on ("util" "ffi")) ))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/Makefile.common
by cl-gsl-cvs＠common-lisp.net 30 Apr '05

30 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4038 Modified Files: Makefile.common Log Message: Changed name of cwrapperstub.so to gsl_cwrapper.so Date: Sun May 1 00:32:16 2005 Author: edenny Index: cl-gsl/Makefile.common diff -u cl-gsl/Makefile.common:1.1.1.1 cl-gsl/Makefile.common:1.2 --- cl-gsl/Makefile.common:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/Makefile.common Sun May 1 00:32:15 2005 @@ -2,4 +2,4 @@ #### Author: Edgar Denny <edgardenny(a)comcast.net> #### Common Makefile options -STUBS= cwrapperstub.$(SHLIB_SUFFIX) +STUBS= gsl_cwrapper.$(SHLIB_SUFFIX)

1 0

[cl-gsl-cvs] CVS update: cl-gsl/ChangeLog
by cl-gsl-cvs＠common-lisp.net 28 Apr '05

28 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv21570 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 28 04:43:55 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.18 cl-gsl/ChangeLog:1.19 --- cl-gsl/ChangeLog:1.18 Mon Apr 25 04:20:14 2005 +++ cl-gsl/ChangeLog Thu Apr 28 04:43:55 2005 @@ -1,3 +1,14 @@ +2005-04-28 Edgar Denny <edgardenny(a)comcast.net> + + * test/test-matrix.lisp: + Added tests for newly added functions to matrix.lisp. + + * package.lisp: + Added additional matrix related symbols to be exported from cl-array. + + * matrix.lisp: + Added functions that require vectors as well as matricies. + 2005-04-25 Edgar Denny <edgardenny(a)comcast.net> * test/test-matrix.lisp: Initial checkin.

1 0

[cl-gsl-cvs] CVS update: cl-gsl/test/test-matrix.lisp
by cl-gsl-cvs＠common-lisp.net 28 Apr '05

28 Apr '05

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)))))))))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/package.lisp
by cl-gsl-cvs＠common-lisp.net 28 Apr '05

28 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv21433 Modified Files: package.lisp Log Message: Added additional matrix related symbols to be exported from cl-array. Date: Thu Apr 28 04:40:55 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.8 cl-gsl/package.lisp:1.9 --- cl-gsl/package.lisp:1.8 Fri Apr 22 04:38:07 2005 +++ cl-gsl/package.lisp Thu Apr 28 04:40:55 2005 @@ -147,4 +147,16 @@ #:with-matrix #:with-matrix-copy #:gsl-matrix->lisp-array + #:get-row + #:with-matrix-row + #:get-col + #:with-matrix-col + #:set-row + #:set-col + #:swap-rows + #:swap-cols + #:swap-rowcol + #:transpose + #:copy-transpose + #:with-copy-transpose ))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/matrix.lisp
by cl-gsl-cvs＠common-lisp.net 28 Apr '05

28 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv21385 Modified Files: matrix.lisp Log Message: Added functions that require vectors as well as matricies. Date: Thu Apr 28 04:39:39 2005 Author: edenny Index: cl-gsl/matrix.lisp diff -u cl-gsl/matrix.lisp:1.3 cl-gsl/matrix.lisp:1.4 --- cl-gsl/matrix.lisp:1.3 Fri Apr 22 04:37:26 2005 +++ cl-gsl/matrix.lisp Thu Apr 28 04:39:39 2005 @@ -36,6 +36,7 @@ (let ((type-ptr) (type-val) (type-val-ptr) + (type-vec-ptr) (type-string) (is-real (or (eq typ 'double-float) (eq typ 'single-float) @@ -44,26 +45,31 @@ (cond ((eq typ 'double-float) (setq type-ptr 'gsl-matrix-ptr) + (setq type-vec-ptr 'gsl-vector-ptr) (setq type-val :double) (setq type-val-ptr '(* :double)) (setq type-string "matrix")) ((eq typ 'single-float) (setq type-ptr 'gsl-matrix-float-ptr) + (setq type-vec-ptr 'gsl-vector-float-ptr) (setq type-val :float) (setq type-val-ptr '(* :float)) (setq type-string "matrix_float")) ((eq typ 'integer) (setq type-ptr 'gsl-matrix-int-ptr) + (setq type-vec-ptr 'gsl-vector-int-ptr) (setq type-val :int) (setq type-val-ptr '(* :int)) (setq type-string "matrix_int")) ((equal typ '(complex (double-float))) (setq type-ptr 'gsl-matrix-complex-ptr) + (setq type-vec-ptr 'gsl-vector-complex-ptr) (setq type-val 'gsl-complex) (setq type-val-ptr '(* gsl-complex)) (setq type-string "matrix_complex")) ((equal typ '(complex (single-float))) (setq type-ptr 'gsl-matrix-complex-float-ptr) + (setq type-vec-ptr 'gsl-vector-complex-float-ptr) (setq type-val 'gsl-complex-float) (setq type-val-ptr '(* gsl-complex-float)) (setq type-string "matrix_complex_float")) @@ -140,6 +146,58 @@ (m2 ,type-ptr)) :int) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_get_row") + ((v ,type-vec-ptr) + (m ,type-ptr) + (row size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_get_col") + ((v ,type-vec-ptr) + (m ,type-ptr) + (col size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_row") + ((m ,type-ptr) + (row size-t) + (v ,type-vec-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_col") + ((m ,type-ptr) + (col size-t) + (v ,type-vec-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap_rows") + ((m ,type-ptr) + (row1 size-t) + (row2 size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap_columns") + ((m ,type-ptr) + (col1 size-t) + (col2 size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap_rowcol") + ((m ,type-ptr) + (row size-t) + (col size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_transpose") + ((m ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_transpose_memcpy") + ((m-dest ,type-ptr) + (m-source ,type-ptr)) + :int) + ,(when is-real `(progn (defun-foreign ,(concatenate 'string "gsl_" type-string "_add") @@ -178,24 +236,25 @@ :int) (defun-foreign ,(concatenate 'string "gsl_" type-string "_max") - ((vec ,type-ptr)) + ((m ,type-ptr)) ,type-val) (defun-foreign ,(concatenate 'string "gsl_" type-string "_min") - ((vec ,type-ptr)) + ((m ,type-ptr)) ,type-val) (defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index") - ((vec ,type-ptr) + ((m ,type-ptr) (i-ptr size-t-ptr) (j-ptr size-t-ptr)) :void) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index") - ((vec ,type-ptr) + ((m ,type-ptr) (i-ptr size-t-ptr) (j-ptr size-t-ptr)) :void) @@ -339,6 +398,78 @@ (1/0->t/nil (,(kmrcl:concat-symbol "gsl-matrix-" func-string "isnull") (ptr o)))) + (defmethod get-row ((o ,class-object) row) + (assert (and (typep row 'integer) (>= row 0) (< row (size-rows o)))) + (let* ((vec (make-vector (size-rows o) :element-type (element-type o))) + (status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "get-row") + (ptr vec) (ptr o) row))) + (values vec status))) + + (defmethod get-col ((o ,class-object) col) + (assert (and (typep col 'integer) (>= col 0) (< col (size-cols o)))) + (let* ((vec (make-vector (size-cols o) :element-type (element-type o))) + (status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "get-col") + (ptr vec) (ptr o) col))) + (values vec status))) + + (defmethod set-row ((o ,class-object) row vec) + (assert (and (typep row 'integer) (>= row 0) (< row (size-rows o)))) + (assert (= (size vec) (size-rows o))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "set-row") + (ptr o) row (ptr vec)))) + (values o status))) + + (defmethod set-col ((o ,class-object) col vec) + (assert (and (typep col 'integer) (>= col 0) (< col (size-cols o)))) + (assert (= (size vec) (size-cols o))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "set-col") + (ptr o) col (ptr vec)))) + (values o status))) + + (defmethod swap-rows ((o ,class-object) row1 row2) + (assert (and (typep row1 'integer) (>= row1 0) (< row1 (size-rows o)))) + (assert (and (typep row2 'integer) (>= row2 0) (< row2 (size-rows o)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "swap-rows") + (ptr o) row1 row2))) + (values o status))) + + (defmethod swap-cols ((o ,class-object) col1 col2) + (assert (and (typep col1 'integer) (>= col1 0) (< col1 (size-cols o)))) + (assert (and (typep col2 'integer) (>= col2 0) (< col2 (size-cols o)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "swap-columns") + (ptr o) col1 col2))) + (values o status))) + + (defmethod swap-rowcol ((o ,class-object) row col) + (assert (= (size-rows o) (size-cols o))) + (assert (and (typep row 'integer) (>= row 0) (< row (size-rows o)))) + (assert (and (typep col 'integer) (>= col 0) (< col (size-cols o)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "swap-rowcol") + (ptr o) row col))) + (values o status))) + + (defmethod transpose ((o ,class-object)) + (assert (= (size-rows o) (size-cols o))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "transpose") + (ptr o)))) + (values o status))) + + (defmethod copy-transpose ((o-dest ,class-object) (o-src, class-object)) + (assert (and (= (size-rows o-dest) (size-rows o-src)) + (= (size-cols o-dest) (size-cols o-src)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "transpose-memcpy") + (ptr o-dest) (ptr o-src)))) + (values o-src status))) + ,(when is-real `(progn (defmethod add ((o1 ,class-object) (o2 ,class-object)) @@ -519,6 +650,24 @@ ,@body (free ,m-dest)))) +(defmacro with-copy-transpose ((m-dest m-src) &body body) + `(gsl-array:with-matrix + (,m-dest (size-rows ,m-src) (size-cols ,m-src) + :element-type (element-type ,m-src)) + (copy-transpose ,m-dest ,m-src) + ,@body)) + +(defmacro with-matrix-row ((v m row) &body body) + `(let ((,v (get-row ,m ,row))) + (unwind-protect + ,@body + (free ,v)))) + +(defmacro with-matrix-col ((v m col) &body body) + `(let ((,v (get-col ,m ,col))) + (unwind-protect + ,@body + (free ,v)))) (defun gsl-matrix->lisp-array (m) (let ((a (make-array (list (size-rows m) (size-cols m)) @@ -527,23 +676,3 @@ (dotimes (j (size-cols m)) (setf (aref a i j) (get-element m i j)))) a)) - - - -;; Function: int gsl_matrix_get_row (gsl_vector * v, const gsl_matrix * m, size_t i) - -;; Function: int gsl_matrix_get_col (gsl_vector * v, const gsl_matrix * m, size_t j) - -;; Function: int gsl_matrix_set_row (gsl_matrix * m, size_t i, const gsl_vector * v) - -;; Function: int gsl_matrix_set_col (gsl_matrix * m, size_t j, const gsl_vector * v) - -;; Function: int gsl_matrix_swap_rows (gsl_matrix * m, size_t i, size_t j) - -;; Function: int gsl_matrix_swap_columns (gsl_matrix * m, size_t i, size_t j) - -;; Function: int gsl_matrix_swap_rowcol (gsl_matrix * m, size_t i, size_t j) - -;; Function: int gsl_matrix_transpose_memcpy (gsl_matrix * dest, const gsl_matrix * src) - -;; Function: int gsl_matrix_transpose (gsl_matrix * m)

1 0

[cl-gsl-cvs] CVS update: cl-gsl/ChangeLog
by cl-gsl-cvs＠common-lisp.net 25 Apr '05

25 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4484 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 25 04:20:14 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.17 cl-gsl/ChangeLog:1.18 --- cl-gsl/ChangeLog:1.17 Fri Apr 22 04:48:09 2005 +++ cl-gsl/ChangeLog Mon Apr 25 04:20:14 2005 @@ -1,3 +1,12 @@ +2005-04-25 Edgar Denny <edgardenny(a)comcast.net> + + * test/test-matrix.lisp: Initial checkin. + + * test/test-vector.lisp: + Add comment to explain checking for failure in test. + + * test/cl-gsl-test.asd: Added test-matrix. + 2005-04-22 Edgar Denny <edgardenny(a)comcast.net> * test/test-vector.lisp:

1 0

[cl-gsl-cvs] CVS update: cl-gsl/test/test-matrix.lisp
by cl-gsl-cvs＠common-lisp.net 25 Apr '05

25 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv4458 Added Files: test-matrix.lisp Log Message: Initial checkin. Date: Mon Apr 25 04:17:38 2005 Author: edenny

1 0

[cl-gsl-cvs] CVS update: cl-gsl/test/test-vector.lisp
by cl-gsl-cvs＠common-lisp.net 25 Apr '05

25 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv4425 Modified Files: test-vector.lisp Log Message: Add comment to explain checking for failure in test. Date: Mon Apr 25 04:16:18 2005 Author: edenny Index: cl-gsl/test/test-vector.lisp diff -u cl-gsl/test/test-vector.lisp:1.5 cl-gsl/test/test-vector.lisp:1.6 --- cl-gsl/test/test-vector.lisp:1.5 Fri Apr 22 04:44:57 2005 +++ cl-gsl/test/test-vector.lisp Mon Apr 25 04:16:18 2005 @@ -515,6 +515,7 @@ #'(lambda () (gsl-array:with-vector (v 5 :element-type 'single-float) (gsl-array:set-basis v 0) + ;; check for failure of isnull (not (gsl-array:isnull v)))))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/test/cl-gsl-test.asd
by cl-gsl-cvs＠common-lisp.net 25 Apr '05

25 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv3581 Modified Files: cl-gsl-test.asd Log Message: Added test-matrix. Date: Mon Apr 25 04:14:32 2005 Author: edenny Index: cl-gsl/test/cl-gsl-test.asd diff -u cl-gsl/test/cl-gsl-test.asd:1.3 cl-gsl/test/cl-gsl-test.asd:1.4 --- cl-gsl/test/cl-gsl-test.asd:1.3 Tue Mar 15 04:20:57 2005 +++ cl-gsl/test/cl-gsl-test.asd Mon Apr 25 04:14:32 2005 @@ -36,4 +36,5 @@ (:file "test-sf" :depends-on ("tolerance")) (:file "test-poly" :depends-on ("tolerance")) (:file "test-vector" :depends-on ("tolerance")) + (:file "test-matrix" :depends-on ("tolerance")) ))

1 0