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

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

22 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv15898 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Fri Apr 22 04:48:09 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.16 cl-gsl/ChangeLog:1.17 --- cl-gsl/ChangeLog:1.16 Mon Apr 18 03:06:38 2005 +++ cl-gsl/ChangeLog Fri Apr 22 04:48:09 2005 @@ -1,3 +1,18 @@ +2005-04-22 Edgar Denny <edgardenny(a)comcast.net> + + * test/test-vector.lisp: + Replaced references to gsl-vector package with gsl-array package - + since this is now the package that the vector symbols now belong. + + * c/cwrapperstub.c: Added wrappers to matrix functions. + + * vector.lisp: Now part of gsl-array package. A few minor + modifications to some assertions. + + * package.lisp: Added additional matrix symbols to gsl-array package. + + * matrix.lisp: Most functions are now wrapped. + 2005-04-18 Edgar Denny <edgardenny(a)comcast.net> * test/test-vector.lisp:

1 0

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

22 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv15056 Modified Files: test-vector.lisp Log Message: Replaced references to gsl-vector package with gsl-array package - since this is now the package that the vector symbols now belong. Date: Fri Apr 22 04:44:57 2005 Author: edenny Index: cl-gsl/test/test-vector.lisp diff -u cl-gsl/test/test-vector.lisp:1.4 cl-gsl/test/test-vector.lisp:1.5 --- cl-gsl/test/test-vector.lisp:1.4 Mon Apr 18 03:00:12 2005 +++ cl-gsl/test/test-vector.lisp Fri Apr 22 04:44:57 2005 @@ -24,123 +24,123 @@ (deftest "make-vector-double-float" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 :element-type 'double-float))) + (let ((v (gsl-array:make-vector 5 :element-type 'double-float))) (prog1 - (and (= (gsl-vector::size v) 5) - (eq (gsl-vector::element-type v) 'double-float)) - (gsl-vector:free v))))) + (and (= (gsl-array::size v) 5) + (eq (gsl-array::element-type v) 'double-float)) + (gsl-array:free v))))) (deftest "make-vector-single-float" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 :element-type 'single-float))) + (let ((v (gsl-array:make-vector 5 :element-type 'single-float))) (prog1 - (and (= (gsl-vector::size v) 5) - (eq (gsl-vector::element-type v) 'single-float)) - (gsl-vector:free v))))) + (and (= (gsl-array::size v) 5) + (eq (gsl-array::element-type v) 'single-float)) + (gsl-array:free v))))) (deftest "make-vector-integer" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 :element-type 'integer))) + (let ((v (gsl-array:make-vector 5 :element-type 'integer))) (prog1 - (and (= (gsl-vector::size v) 5) - (eq (gsl-vector::element-type v) 'integer)) - (gsl-vector:free v))))) + (and (= (gsl-array::size v) 5) + (eq (gsl-array::element-type v) 'integer)) + (gsl-array:free v))))) (deftest "make-vector-complex-double-float" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 :element-type + (let ((v (gsl-array:make-vector 5 :element-type '(complex (double-float))))) (prog1 - (and (= (gsl-vector::size v) 5) - (equal (gsl-vector::element-type v) + (and (= (gsl-array::size v) 5) + (equal (gsl-array::element-type v) '(complex (double-float)))) - (gsl-vector:free v))))) + (gsl-array:free v))))) (deftest "make-vector-complex-single-float" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 :element-type + (let ((v (gsl-array:make-vector 5 :element-type '(complex (single-float))))) (prog1 - (and (= (gsl-vector::size v) 5) - (equal (gsl-vector::element-type v) + (and (= (gsl-array::size v) 5) + (equal (gsl-array::element-type v) '(complex (single-float)))) - (gsl-vector:free v))))) + (gsl-array:free v))))) ;; ---------------------------------------------------------------------- (deftest "make-vector-double-float-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 + (let ((v (gsl-array:make-vector 5 :element-type 'double-float :initial-element 1.0d0)) (ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 1.0d0) + (unless (= (gsl-array:get-element v i) 1.0d0) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-single-float-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 + (let ((v (gsl-array:make-vector 5 :element-type 'single-float :initial-element 1.0)) (ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 1.0) + (unless (= (gsl-array:get-element v i) 1.0) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-integer-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 + (let ((v (gsl-array:make-vector 5 :element-type 'integer :initial-element 1)) (ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 1) + (unless (= (gsl-array:get-element v i) 1) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-complex-double-float-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 + (let ((v (gsl-array:make-vector 5 :element-type '(complex (double-float)) :initial-element (complex 1.0d0 1.0d0))) (ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) (complex 1.0d0 1.0d0)) + (unless (= (gsl-array:get-element v i) (complex 1.0d0 1.0d0)) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-complex-single-float-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector 5 :element-type + (let ((v (gsl-array:make-vector 5 :element-type '(complex (single-float)) :initial-element (complex 1.0 1.0))) (ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) (complex 1.0 1.0)) + (unless (= (gsl-array:get-element v i) (complex 1.0 1.0)) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) ;; ---------------------------------------------------------------------- @@ -148,54 +148,54 @@ (deftest "make-vector-double-float-initial-contents" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector + (let ((v (gsl-array:make-vector 5 :element-type 'double-float :initial-contents (list 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))) (ret t) (val 0.0d0)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) (incf val 1.0d0)) + (unless (= (gsl-array:get-element v i) (incf val 1.0d0)) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-single-float-initial-contents" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector + (let ((v (gsl-array:make-vector 5 :element-type 'single-float :initial-contents (vector -1.0 -2.0 -3.0 -4.0 -5.0))) (ret t) (val 0.0)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) (decf val 1.0)) + (unless (= (gsl-array:get-element v i) (decf val 1.0)) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-integer-initial-contents" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector + (let ((v (gsl-array:make-vector 5 :element-type 'integer :initial-contents (list 1 2 3 4 5))) (ret t) (val 0)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) (incf val)) + (unless (= (gsl-array:get-element v i) (incf val)) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-complex-double-float-initial-contents" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector + (let ((v (gsl-array:make-vector 5 :element-type '(complex (double-float)) :initial-contents @@ -205,16 +205,16 @@ (ret t) (val (complex 0.0d0 0.0d0))) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (incf val (complex 1.0d0 1.0d0))) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) (deftest "make-vector-complex-single-float-initial-contents" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-vector:make-vector + (let ((v (gsl-array:make-vector 5 :element-type '(complex (single-float)) :initial-contents @@ -224,10 +224,10 @@ (ret t) (val (complex 0.0 0.0))) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (decf val (complex 1.0 1.0))) (setq ret nil))) - (gsl-vector:free v) + (gsl-array:free v) ret))) ;; ---------------------------------------------------------------------- @@ -235,55 +235,55 @@ (deftest "set-all-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'double-float) - (gsl-vector:set-all v 5.0d0) + (gsl-array:with-vector (v 5 :element-type 'double-float) + (gsl-array:set-all v 5.0d0) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 5.0d0) + (unless (= (gsl-array:get-element v i) 5.0d0) (setq ret nil))))))) (deftest "set-all-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'single-float) - (gsl-vector:set-all v 5.0) + (gsl-array:with-vector (v 5 :element-type 'single-float) + (gsl-array:set-all v 5.0) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 5.0) + (unless (= (gsl-array:get-element v i) 5.0) (setq ret nil))))))) (deftest "set-all-integer" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'integer) - (gsl-vector:set-all v 5) + (gsl-array:with-vector (v 5 :element-type 'integer) + (gsl-array:set-all v 5) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 5) + (unless (= (gsl-array:get-element v i) 5) (setq ret nil))))))) (deftest "set-all-complex-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (double-float))) - (gsl-vector:set-all v (complex 5.0d0 4.0d0)) + (gsl-array:set-all v (complex 5.0d0 4.0d0)) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 5.0d0 4.0d0)) (setq ret nil))))))) (deftest "set-all-complex-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (single-float))) - (gsl-vector:set-all v (complex 5.0 4.0)) + (gsl-array:set-all v (complex 5.0 4.0)) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) (complex 5.0 4.0)) + (unless (= (gsl-array:get-element v i) (complex 5.0 4.0)) (setq ret nil))))))) ;; ---------------------------------------------------------------------- @@ -291,60 +291,60 @@ (deftest "set-zero-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'double-float) - (gsl-vector:set-all v 5.0d0) - (gsl-vector:set-zero v) + (gsl-array:with-vector (v 5 :element-type 'double-float) + (gsl-array:set-all v 5.0d0) + (gsl-array:set-zero v) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 0.0d0) + (unless (= (gsl-array:get-element v i) 0.0d0) (setq ret nil))))))) (deftest "set-zero-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'single-float) - (gsl-vector:set-all v 5.0) - (gsl-vector:set-zero v) + (gsl-array:with-vector (v 5 :element-type 'single-float) + (gsl-array:set-all v 5.0) + (gsl-array:set-zero v) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 0.0) + (unless (= (gsl-array:get-element v i) 0.0) (setq ret nil))))))) (deftest "set-zero-integer" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'integer) - (gsl-vector:set-all v 5) - (gsl-vector:set-zero v) + (gsl-array:with-vector (v 5 :element-type 'integer) + (gsl-array:set-all v 5) + (gsl-array:set-zero v) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) 0) + (unless (= (gsl-array:get-element v i) 0) (setq ret nil))))))) (deftest "set-zero-complex-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (double-float))) - (gsl-vector:set-all v (complex 5.0d0 4.0d0)) - (gsl-vector:set-zero v) + (gsl-array:set-all v (complex 5.0d0 4.0d0)) + (gsl-array:set-zero v) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 0.0d0 0.0d0)) (setq ret nil))))))) (deftest "set-zero-complex-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (single-float))) - (gsl-vector:set-all v (complex 5.0 4.0)) - (gsl-vector:set-zero v) + (gsl-array:set-all v (complex 5.0 4.0)) + (gsl-array:set-zero v) (let ((ret t)) (dotimes (i 5 ret) - (unless (= (gsl-vector:get-element v i) (complex 0.0 0.0)) + (unless (= (gsl-array:get-element v i) (complex 0.0 0.0)) (setq ret nil))))))) ;; ---------------------------------------------------------------------- @@ -352,71 +352,71 @@ (deftest "set-basis-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'double-float) - (gsl-vector:set-basis v 3) + (gsl-array:with-vector (v 5 :element-type 'double-float) + (gsl-array:set-basis v 3) (let ((ret t)) (dotimes (i 5 ret) (if (= i 3) - (unless (= (gsl-vector:get-element v i) 1.0d0) + (unless (= (gsl-array:get-element v i) 1.0d0) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) 0.0d0) + (unless (= (gsl-array:get-element v i) 0.0d0) (setq ret nil)))))))) (deftest "set-basis-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'single-float) - (gsl-vector:set-basis v 2) + (gsl-array:with-vector (v 5 :element-type 'single-float) + (gsl-array:set-basis v 2) (let ((ret t)) (dotimes (i 5 ret) (if (= i 2) - (unless (= (gsl-vector:get-element v i) 1.0) + (unless (= (gsl-array:get-element v i) 1.0) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) 0.0) + (unless (= (gsl-array:get-element v i) 0.0) (setq ret nil)))))))) (deftest "set-basis-integer" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'integer) - (gsl-vector:set-basis v 1) + (gsl-array:with-vector (v 5 :element-type 'integer) + (gsl-array:set-basis v 1) (let ((ret t)) (dotimes (i 5 ret) (if (= i 1) - (unless (= (gsl-vector:get-element v i) 1) + (unless (= (gsl-array:get-element v i) 1) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) 0) + (unless (= (gsl-array:get-element v i) 0) (setq ret nil)))))))) (deftest "set-basis-complex-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (double-float))) - (gsl-vector:set-basis v 4) + (gsl-array:set-basis v 4) (let ((ret t)) (dotimes (i 5 ret) (if (= i 4) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 1.0d0 0.0d0)) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 0.0d0 0.0d0)) (setq ret nil)))))))) (deftest "set-basis-complex-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (single-float))) - (gsl-vector:set-basis v 0) + (gsl-array:set-basis v 0) (let ((ret t)) (dotimes (i 5 ret) (if (= i 0) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 1.0 0.0)) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 0.0 0.0)) (setq ret nil)))))))) @@ -426,77 +426,77 @@ (deftest "set-element-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'double-float) - (gsl-vector:set-zero v) - (gsl-vector:set-element v 3 6.0d0) + (gsl-array:with-vector (v 5 :element-type 'double-float) + (gsl-array:set-zero v) + (gsl-array:set-element v 3 6.0d0) (let ((ret t)) (dotimes (i 5 ret) (if (= i 3) - (unless (= (gsl-vector:get-element v i) 6.0d0) + (unless (= (gsl-array:get-element v i) 6.0d0) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) 0.0d0) + (unless (= (gsl-array:get-element v i) 0.0d0) (setq ret nil)))))))) (deftest "set-element-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'single-float) - (gsl-vector:set-zero v) - (gsl-vector:set-element v 2 6.0) + (gsl-array:with-vector (v 5 :element-type 'single-float) + (gsl-array:set-zero v) + (gsl-array:set-element v 2 6.0) (let ((ret t)) (dotimes (i 5 ret) (if (= i 2) - (unless (= (gsl-vector:get-element v i) 6.0) + (unless (= (gsl-array:get-element v i) 6.0) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) 0.0) + (unless (= (gsl-array:get-element v i) 0.0) (setq ret nil)))))))) (deftest "set-element-integer" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'integer) - (gsl-vector:set-zero v) - (gsl-vector:set-element v 1 6) + (gsl-array:with-vector (v 5 :element-type 'integer) + (gsl-array:set-zero v) + (gsl-array:set-element v 1 6) (let ((ret t)) (dotimes (i 5 ret) (if (= i 1) - (unless (= (gsl-vector:get-element v i) 6) + (unless (= (gsl-array:get-element v i) 6) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) 0) + (unless (= (gsl-array:get-element v i) 0) (setq ret nil)))))))) (deftest "set-element-complex-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (double-float))) - (gsl-vector:set-zero v) - (gsl-vector:set-element v 4 (complex 6.0d0 7.0d0)) + (gsl-array:set-zero v) + (gsl-array:set-element v 4 (complex 6.0d0 7.0d0)) (let ((ret t)) (dotimes (i 5 ret) (if (= i 4) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 6.0d0 7.0d0)) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 0.0d0 0.0d0)) (setq ret nil)))))))) (deftest "set-element-complex-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (single-float))) - (gsl-vector:set-zero v) - (gsl-vector:set-element v 0 (complex 6.0 7.0)) + (gsl-array:set-zero v) + (gsl-array:set-element v 0 (complex 6.0 7.0)) (let ((ret t)) (dotimes (i 5 ret) (if (= i 0) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 6.0 7.0)) (setq ret nil)) - (unless (= (gsl-vector:get-element v i) + (unless (= (gsl-array:get-element v i) (complex 0.0 0.0)) (setq ret nil)))))))) @@ -505,41 +505,41 @@ (deftest "isnull-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'double-float) - (gsl-vector:set-zero v) - (gsl-vector:isnull v)))) + (gsl-array:with-vector (v 5 :element-type 'double-float) + (gsl-array:set-zero v) + (gsl-array:isnull v)))) (deftest "isnull-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'single-float) - (gsl-vector:set-basis v 0) - (not (gsl-vector:isnull v))))) + (gsl-array:with-vector (v 5 :element-type 'single-float) + (gsl-array:set-basis v 0) + (not (gsl-array:isnull v))))) (deftest "isnull-integer" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector (v 5 :element-type 'integer) - (gsl-vector:set-zero v) - (gsl-vector:isnull v)))) + (gsl-array:with-vector (v 5 :element-type 'integer) + (gsl-array:set-zero v) + (gsl-array:isnull v)))) (deftest "isnull-complex-double-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (double-float))) - (gsl-vector:set-basis v 1) - (not (gsl-vector:isnull v))))) + (gsl-array:set-basis v 1) + (not (gsl-array:isnull v))))) (deftest "isnull-complex-single-float" :category +vector+ :test-fn #'(lambda () - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (single-float))) - (gsl-vector:set-zero v) - (gsl-vector:isnull v)))) + (gsl-array:set-zero v) + (gsl-array:isnull v)))) ;; ---------------------------------------------------------------------- @@ -547,31 +547,31 @@ :test-fn #'(lambda () (let ((vec (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type 'double-float :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl->lisp-vector - (gsl-vector:reverse-vector v))))))) + (gsl-array:gsl->lisp-vector + (gsl-array:reverse-vector v))))))) (deftest "reverse-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1.0 2.0 3.0 4.0 5.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type 'single-float :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl->lisp-vector - (gsl-vector:reverse-vector v))))))) + (gsl-array:gsl->lisp-vector + (gsl-array:reverse-vector v))))))) (deftest "reverse-integer" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1 2 3 4 5))) - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type 'integer :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl->lisp-vector - (gsl-vector:reverse-vector v))))))) + (gsl-array:gsl->lisp-vector + (gsl-array:reverse-vector v))))))) (deftest "reverse-complex-double-float" :category +vector+ @@ -580,12 +580,12 @@ (let ((vec (vector (complex 1.0d0 1.0d0) (complex 2.0d0 2.0d0) (complex 3.0d0 3.0d0) (complex 4.0d0 4.0d0) (complex 5.0d0 5.0d0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (double-float)) :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl->lisp-vector - (gsl-vector:reverse-vector v))))))) + (gsl-array:gsl->lisp-vector + (gsl-array:reverse-vector v))))))) (deftest "reverse-complex-single-float" :category +vector+ @@ -594,12 +594,12 @@ (let ((vec (vector (complex -1.0 -1.0) (complex -2.0 -2.0) (complex -3.0 -3.0) (complex -4.0 -4.0) (complex -5.0 -5.0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v 5 :element-type '(complex (single-float)) :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl->lisp-vector - (gsl-vector:reverse-vector v))))))) + (gsl-array:gsl->lisp-vector + (gsl-array:reverse-vector v))))))) ;; ---------------------------------------------------------------------- @@ -607,39 +607,39 @@ :test-fn #'(lambda () (let ((vec (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec) - (gsl-vector:write-to-file "/tmp/test.txt" v1) - (gsl-vector:with-vector + (gsl-array:write-to-file "/tmp/test.txt" v1) + (gsl-array:with-vector (v2 5 :element-type 'double-float :from-file "/tmp/test.txt") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1.0 2.0 3.0 4.0 5.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec) - (gsl-vector:write-to-file "/tmp/test.txt" v1) - (gsl-vector:with-vector + (gsl-array:write-to-file "/tmp/test.txt" v1) + (gsl-array:with-vector (v2 5 :element-type 'single-float :from-file "/tmp/test.txt") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-integer" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1 2 3 4 5))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec) - (gsl-vector:write-to-file "/tmp/test.txt" v1) - (gsl-vector:with-vector + (gsl-array:write-to-file "/tmp/test.txt" v1) + (gsl-array:with-vector (v2 5 :element-type 'integer :from-file "/tmp/test.txt") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-complex-double-float" :category +vector+ :test-fn @@ -647,15 +647,15 @@ (let ((vec (vector (complex 1.0d0 1.0d0) (complex 2.0d0 2.0d0) (complex 3.0d0 3.0d0) (complex 4.0d0 4.0d0) (complex 5.0d0 5.0d0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (double-float)) :initial-contents vec) - (gsl-vector:write-to-file "/tmp/test.txt" v1) - (gsl-vector:with-vector + (gsl-array:write-to-file "/tmp/test.txt" v1) + (gsl-array:with-vector (v2 5 :element-type '(complex (double-float)) :from-file "/tmp/test.txt") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-complex-single-float" :category +vector+ :test-fn @@ -663,15 +663,15 @@ (let ((vec (vector (complex 1.0 1.0) (complex 2.0 2.0) (complex 3.0 3.0) (complex 4.0 4.0) (complex 5.0 5.0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (single-float)) :initial-contents vec) - (gsl-vector:write-to-file "/tmp/test.txt" v1) - (gsl-vector:with-vector + (gsl-array:write-to-file "/tmp/test.txt" v1) + (gsl-array:with-vector (v2 5 :element-type '(complex (single-float)) :from-file "/tmp/test.txt") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) ;; ---------------------------------------------------------------------- @@ -680,38 +680,38 @@ :test-fn #'(lambda () (let ((vec (vector 1.0000000000001d0 2.0d0 3.0d0 4.0d0 5.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec) - (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) - (gsl-vector:with-vector (v2 5 :element-type 'double-float + (gsl-array:write-to-binary-file "/tmp/test.bin" v1) + (gsl-array:with-vector (v2 5 :element-type 'double-float :from-binary-file "/tmp/test.bin") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1.0 2.0 3.0 4.0 5.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec) - (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) - (gsl-vector:with-vector (v2 5 :element-type 'single-float + (gsl-array:write-to-binary-file "/tmp/test.bin" v1) + (gsl-array:with-vector (v2 5 :element-type 'single-float :from-binary-file "/tmp/test.bin") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-integer" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1 2 3 4 5))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec) - (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) - (gsl-vector:with-vector (v2 5 :element-type 'integer + (gsl-array:write-to-binary-file "/tmp/test.bin" v1) + (gsl-array:with-vector (v2 5 :element-type 'integer :from-binary-file "/tmp/test.bin") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-complex-double-float" :category +vector+ :test-fn @@ -719,15 +719,15 @@ (let ((vec (vector (complex 1.0d0 1.0d0) (complex 2.0d0 2.0d0) (complex 3.0d0 3.0d0) (complex 4.0d0 4.0d0) (complex 5.0d0 5.0d0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (double-float)) :initial-contents vec) - (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) - (gsl-vector:with-vector + (gsl-array:write-to-binary-file "/tmp/test.bin" v1) + (gsl-array:with-vector (v2 5 :element-type '(complex (double-float)) :from-binary-file "/tmp/test.bin") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-complex-single-float" :category +vector+ :test-fn @@ -735,15 +735,15 @@ (let ((vec (vector (complex 1.0 1.0) (complex 2.0 2.0) (complex 3.0 3.0) (complex 4.0 4.0) (complex 5.0 5.0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (single-float)) :initial-contents vec) - (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) - (gsl-vector:with-vector + (gsl-array:write-to-binary-file "/tmp/test.bin" v1) + (gsl-array:with-vector (v2 5 :element-type '(complex (single-float)) :from-binary-file "/tmp/test.bin") - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) ;; ---------------------------------------------------------------------- @@ -753,33 +753,33 @@ (let ((vec (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (v2) (res)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec) - (setq v2 (gsl-vector:copy v1)) - (setq res (equalp (gsl-vector:gsl->lisp-vector v1) - (gsl-vector:gsl->lisp-vector v2))) - (gsl-vector:free v2)) + (setq v2 (gsl-array:copy v1)) + (setq res (equalp (gsl-array:gsl->lisp-vector v1) + (gsl-array:gsl->lisp-vector v2))) + (gsl-array:free v2)) res))) (deftest "copy-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1.0 2.0 3.0 4.0 5.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec) - (gsl-vector:with-vector-copy (v2 v1) - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:with-vector-copy (v2 v1) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "copy-integer" :category +vector+ :test-fn #'(lambda () (let ((vec (vector 1 2 3 4 5))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec) - (gsl-vector:with-vector-copy (v2 v1) - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:with-vector-copy (v2 v1) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "copy-complex-double-float" :category +vector+ :test-fn @@ -787,12 +787,12 @@ (let ((vec (vector (complex 1.0d0 1.0d0) (complex 2.0d0 2.0d0) (complex 3.0d0 3.0d0) (complex 4.0d0 4.0d0) (complex 5.0d0 5.0d0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (double-float)) :initial-contents vec) - (gsl-vector:with-vector-copy (v2 v1) - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:with-vector-copy (v2 v1) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) (deftest "copy-complex-single-float" :category +vector+ :test-fn @@ -800,12 +800,12 @@ (let ((vec (vector (complex 1.0 1.0) (complex 2.0 2.0) (complex 3.0 3.0) (complex 4.0 4.0) (complex 5.0 5.0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (single-float)) :initial-contents vec) - (gsl-vector:with-vector-copy (v2 v1) - (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) - (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:with-vector-copy (v2 v1) + (and (equalp vec (gsl-array:gsl->lisp-vector v1)) + (equalp vec (gsl-array:gsl->lisp-vector v2)))))))) ;; ---------------------------------------------------------------------- @@ -815,39 +815,39 @@ #'(lambda () (let* ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (reverse vec-1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'double-float :initial-contents vec-2) - (gsl-vector:swap v1 v2) - (and (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)) - (equalp vec-1 (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:swap v1 v2) + (and (equalp vec-2 (gsl-array:gsl->lisp-vector v1)) + (equalp vec-1 (gsl-array:gsl->lisp-vector v2)))))))) (deftest "swap-single-float" :category +vector+ :test-fn #'(lambda () (let* ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (reverse vec-1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'single-float :initial-contents vec-2) - (gsl-vector:swap v1 v2) - (and (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)) - (equalp vec-1 (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:swap v1 v2) + (and (equalp vec-2 (gsl-array:gsl->lisp-vector v1)) + (equalp vec-1 (gsl-array:gsl->lisp-vector v2)))))))) (deftest "swap-integer" :category +vector+ :test-fn #'(lambda () (let* ((vec-1 (vector 1 2 3 4 5)) (vec-2 (reverse vec-1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'integer :initial-contents vec-2) - (gsl-vector:swap v1 v2) - (and (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)) - (equalp vec-1 (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:swap v1 v2) + (and (equalp vec-2 (gsl-array:gsl->lisp-vector v1)) + (equalp vec-1 (gsl-array:gsl->lisp-vector v2)))))))) (deftest "swap-complex-double-float" :category +vector+ :test-fn @@ -856,15 +856,15 @@ (complex 3.0d0 3.0d0) (complex 4.0d0 4.0d0) (complex 5.0d0 5.0d0))) (vec-2 (reverse vec-1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (double-float)) :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type '(complex (double-float)) :initial-contents vec-2) - (gsl-vector:swap v1 v2) - (and (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)) - (equalp vec-1 (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:swap v1 v2) + (and (equalp vec-2 (gsl-array:gsl->lisp-vector v1)) + (equalp vec-1 (gsl-array:gsl->lisp-vector v2)))))))) (deftest "swap-complex-single-float" :category +vector+ :test-fn @@ -873,15 +873,15 @@ (complex 3.0 3.0) (complex 4.0 4.0) (complex 5.0 5.0))) (vec-2 (reverse vec-1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (single-float)) :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type '(complex (single-float)) :initial-contents vec-2) - (gsl-vector:swap v1 v2) - (and (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)) - (equalp vec-1 (gsl-vector:gsl->lisp-vector v2)))))))) + (gsl-array:swap v1 v2) + (and (equalp vec-2 (gsl-array:gsl->lisp-vector v1)) + (equalp vec-1 (gsl-array:gsl->lisp-vector v2)))))))) ;; ---------------------------------------------------------------------- @@ -890,30 +890,30 @@ #'(lambda () (let ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (vector 1.0d0 2.0d0 4.0d0 3.0d0 5.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:swap-elements v1 2 3) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:swap-elements v1 2 3) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "swap-elements-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (vector 1.0 2.0 4.0 3.0 5.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:swap-elements v1 2 3) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:swap-elements v1 2 3) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "swap-elements-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1 2 3 4 5)) (vec-2 (vector 1 2 4 3 5))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:swap-elements v1 2 3) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:swap-elements v1 2 3) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "swap-elements-complex-double-float" :category +vector+ :test-fn @@ -924,11 +924,11 @@ (vec-2 (vector (complex 1.0d0 1.0d0) (complex 2.0d0 2.0d0) (complex 4.0d0 4.0d0) (complex 3.0d0 3.0d0) (complex 5.0d0 5.0d0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (double-float)) :initial-contents vec-1) - (gsl-vector:swap-elements v1 2 3) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:swap-elements v1 2 3) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "swap-elements-complex-single-float" :category +vector+ :test-fn @@ -939,11 +939,11 @@ (vec-2 (vector (complex 1.0 1.0) (complex 2.0 2.0) (complex 4.0 4.0) (complex 3.0 3.0) (complex 5.0 5.0)))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type '(complex (single-float)) :initial-contents vec-1) - (equalp vec-2 (gsl-vector:gsl->lisp-vector - (gsl-vector:swap-elements v1 2 3))))))) + (equalp vec-2 (gsl-array:gsl->lisp-vector + (gsl-array:swap-elements v1 2 3))))))) ;; ---------------------------------------------------------------------- @@ -952,36 +952,36 @@ #'(lambda () (let ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (vector 2.0d0 4.0d0 6.0d0 8.0d0 10.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:add v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:add v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "add-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (vector 2.0 4.0 6.0 8.0 10.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:add v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:add v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "add-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1 2 3 4 5)) (vec-2 (vector 2 4 6 8 10))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:add v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:add v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) ;; ---------------------------------------------------------------------- @@ -991,36 +991,36 @@ #'(lambda () (let ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (vector 0.0d0 0.0d0 0.0d0 0.0d0 0.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:sub v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:sub v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "sub-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (vector 0.0 0.0 0.0 0.0 0.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:sub v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:sub v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "sub-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1 2 3 4 5)) (vec-2 (vector 0 0 0 0 0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:sub v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:sub v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) ;; ---------------------------------------------------------------------- @@ -1029,36 +1029,36 @@ #'(lambda () (let ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (vector 1.0d0 4.0d0 9.0d0 16.0d0 25.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:mul v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:mul v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "mul-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (vector 1.0 4.0 9.0 16.0 25.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:mul v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:mul v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "mul-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1 2 3 4 5)) (vec-2 (vector 1 4 9 16 25))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:mul v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:mul v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) ;; ---------------------------------------------------------------------- @@ -1067,36 +1067,36 @@ #'(lambda () (let ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (vector 1.0d0 1.0d0 1.0d0 1.0d0 1.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:div v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:div v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "div-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (vector 1.0 1.0 1.0 1.0 1.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:div v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:div v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) (deftest "div-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1 2 3 4 5)) (vec-2 (vector 1 1 1 1 1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:with-vector + (gsl-array:with-vector (v2 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:div v1 v2) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1))))))) + (gsl-array:div v1 v2) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1))))))) ;; ---------------------------------------------------------------------- @@ -1106,30 +1106,30 @@ #'(lambda () (let ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (vector 10.0d0 20.0d0 30.0d0 40.0d0 50.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:scale v1 10.0d0) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:scale v1 10.0d0) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "scale-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (vector 10.0 20.0 30.0 40.0 50.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:scale v1 10.0) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:scale v1 10.0) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "scale-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1 2 3 4 5)) (vec-2 (vector 10 20 30 40 50))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:scale v1 10) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:scale v1 10) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) ;; ---------------------------------------------------------------------- @@ -1139,30 +1139,30 @@ #'(lambda () (let ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) (vec-2 (vector 11.0d0 12.0d0 13.0d0 14.0d0 15.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (gsl-vector:add-constant v1 10.0d0) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:add-constant v1 10.0d0) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "add-constant-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1.0 2.0 3.0 4.0 5.0)) (vec-2 (vector 11.0 12.0 13.0 14.0 15.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (gsl-vector:add-constant v1 10.0) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:add-constant v1 10.0) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) (deftest "add-constant-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 1 2 3 4 5)) (vec-2 (vector 11 12 13 14 15))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (gsl-vector:add-constant v1 10) - (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + (gsl-array:add-constant v1 10) + (equalp vec-2 (gsl-array:gsl->lisp-vector v1)))))) ;; ---------------------------------------------------------------------- @@ -1171,27 +1171,27 @@ #'(lambda () (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) (max-val 5.0d0)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (= max-val (gsl-vector:max-value v1)))))) + (= max-val (gsl-array:max-value v1)))))) (deftest "max-value-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4.0 5.0 1.0 2.0 3.0)) (max-val 5.0)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (= max-val (gsl-vector:max-value v1)))))) + (= max-val (gsl-array:max-value v1)))))) (deftest "max-value-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4 5 1 2 3)) (max-val 5)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (= max-val (gsl-vector:max-value v1)))))) + (= max-val (gsl-array:max-value v1)))))) ;; ---------------------------------------------------------------------- @@ -1200,27 +1200,27 @@ #'(lambda () (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) (min-val 1.0d0)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (= min-val (gsl-vector:min-value v1)))))) + (= min-val (gsl-array:min-value v1)))))) (deftest "min-value-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4.0 5.0 1.0 2.0 3.0)) (min-val 1.0)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (= min-val (gsl-vector:min-value v1)))))) + (= min-val (gsl-array:min-value v1)))))) (deftest "min-value-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4 5 1 2 3)) (min-val 1)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (= min-val (gsl-vector:min-value v1)))))) + (= min-val (gsl-array:min-value v1)))))) ;; ---------------------------------------------------------------------- @@ -1229,27 +1229,27 @@ #'(lambda () (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) (max-idx 1)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (= max-idx (gsl-vector:max-index v1)))))) + (= max-idx (gsl-array:max-index v1)))))) (deftest "max-index-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4.0 5.0 1.0 2.0 3.0)) (max-idx 1)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (= max-idx (gsl-vector:max-index v1)))))) + (= max-idx (gsl-array:max-index v1)))))) (deftest "max-index-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4 5 1 2 3)) (max-idx 1)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (= max-idx (gsl-vector:max-index v1)))))) + (= max-idx (gsl-array:max-index v1)))))) ;; ---------------------------------------------------------------------- @@ -1258,27 +1258,27 @@ #'(lambda () (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) (min-idx 2)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (= min-idx (gsl-vector:min-index v1)))))) + (= min-idx (gsl-array:min-index v1)))))) (deftest "min-index-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4.0 5.0 1.0 2.0 3.0)) (min-idx 2)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (= min-idx (gsl-vector:min-index v1)))))) + (= min-idx (gsl-array:min-index v1)))))) (deftest "min-index-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4 5 1 2 3)) (min-idx 2)) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (= min-idx (gsl-vector:min-index v1)))))) + (= min-idx (gsl-array:min-index v1)))))) ;; ---------------------------------------------------------------------- @@ -1287,27 +1287,27 @@ #'(lambda () (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) (min-max-idx '(2 1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (equal min-max-idx (gsl-vector:min-max-indicies v1)))))) + (equal min-max-idx (gsl-array:min-max-indicies v1)))))) (deftest "min-max-indicies-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4.0 5.0 1.0 2.0 3.0)) (min-max-idx '(2 1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (equal min-max-idx (gsl-vector:min-max-indicies v1)))))) + (equal min-max-idx (gsl-array:min-max-indicies v1)))))) (deftest "min-max-indicies-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4 5 1 2 3)) (min-max-idx '(2 1))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (equal min-max-idx (gsl-vector:min-max-indicies v1)))))) + (equal min-max-idx (gsl-array:min-max-indicies v1)))))) ;; ---------------------------------------------------------------------- @@ -1316,25 +1316,25 @@ #'(lambda () (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) (min-max-val '(1.0d0 5.0d0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'double-float :initial-contents vec-1) - (equal min-max-val (gsl-vector:min-max-values v1)))))) + (equal min-max-val (gsl-array:min-max-values v1)))))) (deftest "min-max-values-single-float" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4.0 5.0 1.0 2.0 3.0)) (min-max-val '(1.0 5.0))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'single-float :initial-contents vec-1) - (equal min-max-val (gsl-vector:min-max-values v1)))))) + (equal min-max-val (gsl-array:min-max-values v1)))))) (deftest "min-max-values-integer" :category +vector+ :test-fn #'(lambda () (let ((vec-1 (vector 4 5 1 2 3)) (min-max-val '(1 5))) - (gsl-vector:with-vector + (gsl-array:with-vector (v1 5 :element-type 'integer :initial-contents vec-1) - (equal min-max-val (gsl-vector:min-max-values v1)))))) + (equal min-max-val (gsl-array:min-max-values v1))))))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/c/cwrapperstub.c
by cl-gsl-cvs＠common-lisp.net 22 Apr '05

22 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl/c In directory common-lisp.net:/tmp/cvs-serv15021 Modified Files: cwrapperstub.c Log Message: Added wrappers to matrix functions. Date: Fri Apr 22 04:41:33 2005 Author: edenny Index: cl-gsl/c/cwrapperstub.c diff -u cl-gsl/c/cwrapperstub.c:1.3 cl-gsl/c/cwrapperstub.c:1.4 --- cl-gsl/c/cwrapperstub.c:1.3 Tue Mar 15 04:19:08 2005 +++ cl-gsl/c/cwrapperstub.c Fri Apr 22 04:41:33 2005 @@ -533,3 +533,287 @@ gsl_vector_complex_float_set_all(v , *z); } + +/* ----------------------------------------------------------------- */ + +void wrap_gsl_matrix_complex_float_set(gsl_matrix_complex_float *m, + const size_t i, + const size_t j, + gsl_complex_float *z) +{ + m->data[2 * (i * m->tda + j)] = z->dat[0]; + m->data[(2 * (i * m->tda + j)) + 1] = z->dat[1]; +} + +void wrap_gsl_matrix_complex_set(gsl_matrix_complex *m, + const size_t i, + const size_t j, + gsl_complex *z) +{ + m->data[2 * (i * m->tda + j)] = z->dat[0]; + m->data[(2 * (i * m->tda + j)) + 1] = z->dat[1]; +} + +void wrap_gsl_matrix_complex_set_all(gsl_matrix_complex *m, + gsl_complex *z) +{ + gsl_matrix_complex_set_all(m , *z); +} + +void wrap_gsl_matrix_complex_float_set_all(gsl_matrix_complex_float *m, + gsl_complex_float *z) +{ + gsl_matrix_complex_float_set_all(m , *z); +} + +/* ----------------------------------------------------------------- */ + +int wrap_gsl_matrix_fwrite(char *fn, const gsl_matrix *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "wb"); + ret = gsl_matrix_fwrite(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_fread(char *fn, gsl_matrix *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "rb"); + ret = gsl_matrix_fread(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_fprintf(char *fn, const gsl_matrix *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "w"); + ret = gsl_matrix_fprintf(stream, m, "%lf"); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_fscanf(char *fn, gsl_matrix *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "r"); + ret = gsl_matrix_fscanf(stream, m); + fclose(stream); + + return ret; +} + +/* ----------------------------------------------------------------- */ + +int wrap_gsl_matrix_float_fwrite(char *fn, const gsl_matrix_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "wb"); + ret = gsl_matrix_float_fwrite(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_float_fread(char *fn, gsl_matrix_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "rb"); + ret = gsl_matrix_float_fread(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_float_fprintf(char *fn, const gsl_matrix_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "w"); + ret = gsl_matrix_float_fprintf(stream, m, "%f"); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_float_fscanf(char *fn, gsl_matrix_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "r"); + ret = gsl_matrix_float_fscanf(stream, m); + fclose(stream); + + return ret; +} + +/* ----------------------------------------------------------------- */ + +int wrap_gsl_matrix_int_fwrite(char *fn, const gsl_matrix_int *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "wb"); + ret = gsl_matrix_int_fwrite(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_int_fread(char *fn, gsl_matrix_int *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "rb"); + ret = gsl_matrix_int_fread(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_int_fprintf(char *fn, const gsl_matrix_int *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "w"); + ret = gsl_matrix_int_fprintf(stream, m, "%d"); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_int_fscanf(char *fn, gsl_matrix_int *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "r"); + ret = gsl_matrix_int_fscanf(stream, m); + fclose(stream); + + return ret; +} + +/* ----------------------------------------------------------------- */ + +int wrap_gsl_matrix_complex_fwrite(char *fn, const gsl_matrix_complex *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "wb"); + ret = gsl_matrix_complex_fwrite(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_complex_fread(char *fn, gsl_matrix_complex *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "rb"); + ret = gsl_matrix_complex_fread(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_complex_fprintf(char *fn, const gsl_matrix_complex *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "w"); + ret = gsl_matrix_complex_fprintf(stream, m, "%lf"); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_complex_fscanf(char *fn, gsl_matrix_complex *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "r"); + ret = gsl_matrix_complex_fscanf(stream, m); + fclose(stream); + + return ret; +} + +/* ----------------------------------------------------------------- */ + +int wrap_gsl_matrix_complex_float_fwrite(char *fn, + const gsl_matrix_complex_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "wb"); + ret = gsl_matrix_complex_float_fwrite(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_complex_float_fread(char *fn, gsl_matrix_complex_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "rb"); + ret = gsl_matrix_complex_float_fread(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_complex_float_fprintf(char *fn, + const gsl_matrix_complex_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "w"); + ret = gsl_matrix_complex_float_fprintf(stream, m, "%lf"); + fclose(stream); + + return ret; +} + +int wrap_gsl_matrix_complex_float_fscanf(char *fn, gsl_matrix_complex_float *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "r"); + ret = gsl_matrix_complex_float_fscanf(stream, m); + fclose(stream); + + return ret; +}

1 0

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

22 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv15002 Modified Files: vector.lisp Log Message: Now part of gsl-array package. A few minor modifications to some assertions. Date: Fri Apr 22 04:40:55 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.8 cl-gsl/vector.lisp:1.9 --- cl-gsl/vector.lisp:1.8 Mon Apr 18 02:55:09 2005 +++ cl-gsl/vector.lisp Fri Apr 22 04:40:54 2005 @@ -17,7 +17,7 @@ ;;;; along with this program; if not, write to the Free Software ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -(in-package #:cl-gsl-vector) +(in-package #:cl-gsl-array) (defclass gsl-vector () @@ -277,9 +277,8 @@ (setf (element-type o) nil)) - (defmethod get-element ((o ,class-object) i) - (assert (typep i 'integer)) - (assert (and (>= i 0) (= i 0) (< i (size o)))) ,(if is-real `(,(kmrcl:concat-symbol "gsl-vector-" func-string "get") (ptr o) i) @@ -287,10 +286,9 @@ (,(kmrcl:concat-symbol "gsl-vector-" func-string "ptr") (ptr o) i)))) - (defmethod set-element ((o ,class-object) i x) - (assert (typep i 'integer)) + (defmethod set-element ((o ,class-object) i &optional x dummy) (assert (typep x (element-type o))) - (assert (and (>= i 0) (= i 0) (< i (size o)))) ,(if is-real `(,(kmrcl:concat-symbol "gsl-vector-" func-string "set") (ptr o) i x) @@ -324,8 +322,7 @@ o) - (defmethod read-from-binary-file ((o ,class-object) file-name size) - (assert (and (> size 0) (<= size (size o)))) + (defmethod read-from-binary-file ((o ,class-object) file-name) (let ((status)) (uffi:with-cstring (c-file-name file-name) (setq status @@ -333,8 +330,7 @@ "fread") c-file-name (ptr o)))) (values o status))) - (defmethod read-from-file ((o ,class-object) file-name size) - (assert (and (> size 0) (<= size (size o)))) + (defmethod read-from-file ((o ,class-object) file-name) (let ((status)) (uffi:with-cstring (c-file-name file-name) (setq status @@ -506,9 +502,9 @@ (t (error "initial-contents must be either a list or a vector.")))) (from-file - (read-from-file v from-file size)) + (read-from-file v from-file)) (from-binary-file - (read-from-binary-file v from-binary-file size))) + (read-from-binary-file v from-binary-file))) v)) @@ -555,24 +551,4 @@ ;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v) ;; Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex *v) - -;; ---------------------------------------------------------------------- -;; Functions that I don't think need binding. -;; - -;; Function: gsl_vector * gsl_vector_calloc (size_t n) - -;; Function: double * gsl_vector_ptr (gsl_vector * v, size_t i) -;; Function: const double * gsl_vector_const_ptr (const gsl_vector * v, size_t i) - -;; Function: gsl_vector_const_view gsl_vector_const_subvector (const gsl_vector * v, size_t offset, size_t n) - -;; Function: gsl_vector_const_view gsl_vector_const_subvector_with_stride (const gsl_vector * v, size_t offset, size_t stride, size_t n) - -;; Function: gsl_vector_const_view gsl_vector_complex_const_real (const gsl_vector_complex *v) - -;; Function: gsl_vector_const_view gsl_vector_complex_const_imag (const gsl_vector_complex *v) - -;; Function: gsl_vector_view gsl_vector_view_array_with_stride (double * base, size_t stride, size_t n) -;; Function: gsl_vector_const_view gsl_vector_const_view_array_with_stride (const double * base, size_t stride, size_t n)

1 0

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

22 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv14960 Modified Files: package.lisp Log Message: Added additional matrix symbols to gsl-array package. Date: Fri Apr 22 04:38:07 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.7 cl-gsl/package.lisp:1.8 --- cl-gsl/package.lisp:1.7 Mon Apr 18 02:52:59 2005 +++ cl-gsl/package.lisp Fri Apr 22 04:38:07 2005 @@ -93,13 +93,15 @@ #:legendre-hd3-array )) -(defpackage #:cl-gsl-vector - (:nicknames #:gsl-vector) +(defpackage #:cl-gsl-array + (:nicknames #:gsl-array) (:use #:cl #:cl-gsl) (:export - #:gsl-vec-size - #:gsl-vec-element-type - #:gsl-vec-ptr + + ;; from vector + #:size + #:element-type + #:ptr #:free #:make-vector @@ -134,11 +136,15 @@ #:min-max-values #:isnull #:gsl->lisp-vector - )) -(defpackage #:cl-gsl-matrix - (:nicknames #:gsl-matrix) - (:use #:cl #:cl-gsl) - (:export - #:free-matrix + ;; from matrix + #:make-matrix + #:size-rows + #:size-cols + #:set-identity + #:mul-elements + #:div-elements + #:with-matrix + #:with-matrix-copy + #:gsl-matrix->lisp-array ))

1 0

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

22 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv14937 Modified Files: matrix.lisp Log Message: Most functions are now wrapped. Date: Fri Apr 22 04:37:26 2005 Author: edenny Index: cl-gsl/matrix.lisp diff -u cl-gsl/matrix.lisp:1.2 cl-gsl/matrix.lisp:1.3 --- cl-gsl/matrix.lisp:1.2 Mon Apr 18 02:52:16 2005 +++ cl-gsl/matrix.lisp Fri Apr 22 04:37:26 2005 @@ -17,13 +17,30 @@ ;;;; along with this program; if not, write to the Free Software ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -(in-package #:cl-gsl-matrix) +(in-package #:cl-gsl-array) + +(defclass gsl-matrix () + ((ptr :accessor ptr :initarg :ptr) + (size-rows :accessor size-rows :initarg :size-rows) + (size-cols :accessor size-cols :initarg :size-cols) + (element-type :accessor element-type :initarg :element-type))) + + +(defclass gsl-matrix-double-float (gsl-matrix) ()) +(defclass gsl-matrix-single-float (gsl-matrix) ()) +(defclass gsl-matrix-integer (gsl-matrix) ()) +(defclass gsl-matrix-complex-double-float (gsl-matrix) ()) +(defclass gsl-matrix-complex-single-float (gsl-matrix) ()) (defmacro def-matrix-type-funcs% (typ) (let ((type-ptr) (type-val) (type-val-ptr) - (type-string)) + (type-string) + (is-real (or (eq typ 'double-float) + (eq typ 'single-float) + (eq typ 'integer)))) + (cond ((eq typ 'double-float) (setq type-ptr 'gsl-matrix-ptr) @@ -55,82 +72,462 @@ `(progn (defun-foreign ,(concatenate 'string "gsl_" type-string "_alloc") - ((size-1 size-t) - (size-2 size-t)) + ((size-rows size-t) + (size-cols size-t)) ,type-ptr) (defun-foreign ,(concatenate 'string "gsl_" type-string "_free") ((m ,type-ptr)) :void) - ))) - -(def-matrix-type-funcs% double-float) -(def-matrix-type-funcs% single-float) -(def-matrix-type-funcs% integer) -(def-matrix-type-funcs% (complex (double-float))) -(def-matrix-type-funcs% (complex (single-float))) - - -;; Function: gsl_matrix * gsl_matrix_alloc (size_t n1, size_t n2) - -;; Function: gsl_matrix * gsl_matrix_calloc (size_t n1, size_t n2) -;; Function: void gsl_matrix_free (gsl_matrix * m) - -;; Function: double gsl_matrix_get (const gsl_matrix * m, size_t i, size_t j) - -;; Function: void gsl_matrix_set (gsl_matrix * m, size_t i, size_t j, double x) - -;; Function: double * gsl_matrix_ptr (gsl_matrix * m, size_t i, size_t j) -;; Function: const double * gsl_matrix_const_ptr (const gsl_matrix * m, size_t i, size_t j) - -;; Function: void gsl_matrix_set_all (gsl_matrix * m, double x) - -;; Function: void gsl_matrix_set_zero (gsl_matrix * m) - -;; Function: void gsl_matrix_set_identity (gsl_matrix * m) - -;; Function: int gsl_matrix_fwrite (FILE * stream, const gsl_matrix * m) - -;; Function: int gsl_matrix_fread (FILE * stream, gsl_matrix * m) - -;; Function: int gsl_matrix_fprintf (FILE * stream, const gsl_matrix * m, const char * format) - -;; Function: int gsl_matrix_fscanf (FILE * stream, gsl_matrix * m) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_memcpy") + ((v1 ,type-ptr) + (v2 ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_get") + ((m ,type-ptr) + (i size-t) + (j size-t)) + ,type-val) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set") + ((m ,type-ptr) + (i size-t) + (j size-t) + (x ,type-val)) + :void) -;; Function: gsl_matrix_view gsl_matrix_submatrix (gsl_matrix * m, size_t k1, size_t k2, size_t n1, size_t n2) -;; Function: gsl_matrix_const_view gsl_matrix_const_submatrix (const gsl_matrix * m, size_t k1, size_t k2, size_t n1, size_t n2) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_all") + ((m ,type-ptr) + (x ,type-val)) + :void) -;; Function: gsl_matrix_view gsl_matrix_view_array (double * base, size_t n1, size_t n2) -;; Function: gsl_matrix_const_view gsl_matrix_const_view_array (const double * base, size_t n1, size_t n2) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_zero") + ((m ,type-ptr)) + :void) -;; Function: gsl_matrix_view gsl_matrix_view_array_with_tda (double * base, size_t n1, size_t n2, size_t tda) -;; Function: gsl_matrix_const_view gsl_matrix_const_view_array_with_tda (const double * base, size_t n1, size_t n2, size_t tda) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_identity") + ((m ,type-ptr)) + :void) -;; Function: gsl_matrix_view gsl_matrix_view_vector (gsl_vector * v, size_t n1, size_t n2) -;; Function: gsl_matrix_const_view gsl_matrix_const_view_vector (const gsl_vector * v, size_t n1, size_t n2) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_isnull") + ((m ,type-ptr)) + :int) -;; Function: gsl_matrix_view gsl_matrix_view_vector_with_tda (gsl_vector * v, size_t n1, size_t n2, size_t tda) -;; Function: gsl_matrix_const_view gsl_matrix_const_view_vector_with_tda (const gsl_vector * v, size_t n1, size_t n2, size_t tda) + (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fwrite") + ((fn :cstring) + (m ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fread") + ((fn :cstring) + (m ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fprintf") + ((fn :cstring) + (m ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fscanf") + ((fn :cstring) + (m ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap") + ((m1 ,type-ptr) + (m2 ,type-ptr)) + :int) + + ,(when is-real + `(progn + (defun-foreign ,(concatenate 'string "gsl_" type-string "_add") + ((ma ,type-ptr) + (mb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_sub") + ((ma ,type-ptr) + (mb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_mul_elements") + ((ma ,type-ptr) + (mb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_div_elements") + ((ma ,type-ptr) + (mb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") + ((m ,type-ptr) + ;; seems odd that this is :double for all types + (x :double)) + :int) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_add_constant") + ((m ,type-ptr) + ;; and again, :double for all types + (x :double)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_max") + ((vec ,type-ptr)) + ,type-val) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_min") + ((vec ,type-ptr)) + ,type-val) + + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_max_index") + ((vec ,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) + (i-ptr size-t-ptr) + (j-ptr size-t-ptr)) + :void) + )) + + ,(when (not is-real) + `(progn + (defun-foreign ,(concatenate 'string "gsl_" type-string "_ptr") + ((m ,type-ptr) + (i size-t) + (j size-t)) + (* ,type-val)) + + (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_set") + ((m ,type-ptr) + (i size-t) + (j size-t) + (z (* ,type-val))) + :void) + + (defun-foreign ,(concatenate 'string + "wrap_gsl_" type-string "_set_all") + ((m ,type-ptr) + (z (* ,type-val))) + :void) + )) + ))) -;; Function: gsl_vector_view gsl_matrix_row (gsl_matrix * m, size_t i) -;; Function: gsl_vector_const_view gsl_matrix_const_row (const gsl_matrix * m, size_t i) +(def-matrix-type-funcs% double-float) +(def-matrix-type-funcs% single-float) +(def-matrix-type-funcs% integer) +(def-matrix-type-funcs% (complex (double-float))) +(def-matrix-type-funcs% (complex (single-float))) -;; Function: gsl_vector_view gsl_matrix_column (gsl_matrix * m, size_t j) -;; Function: gsl_vector_const_view gsl_matrix_const_column (const gsl_matrix * m, size_t j) -;; Function: gsl_vector_view gsl_matrix_diagonal (gsl_matrix * m) -;; Function: gsl_vector_const_view gsl_matrix_const_diagonal (const gsl_matrix * m) +(defmacro def-matrix-methods% (class-string func-string) + (let ((class-object (kmrcl:concat-symbol "gsl-matrix-" class-string)) + (is-real (or (string= class-string "integer") + (string= class-string "single-float") + (string= class-string "double-float")))) + `(progn -;; Function: gsl_vector_view gsl_matrix_subdiagonal (gsl_matrix * m, size_t k) -;; Function: gsl_vector_const_view gsl_matrix_const_subdiagonal (const gsl_matrix * m, size_t k) + (defmethod alloc ((o ,class-object)) + (setf (ptr o) (,(kmrcl:concat-symbol "gsl-matrix-" func-string "alloc") + (size-rows o) (size-cols o))) + o) + + (defmethod free ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "free") (ptr o)) + (setf (ptr o) nil) + (setf (size-rows o) nil) + (setf (size-cols o) nil) + (setf (element-type o) nil)) + + (defmethod get-element ((o ,class-object) i &optional j) + (assert (and (typep i 'integer) (>= i 0) (= j 0) (< j (size-cols o)))) + ,(if is-real + `(,(kmrcl:concat-symbol "gsl-matrix-" func-string "get") + (ptr o) i j) + `(,(kmrcl:concat-symbol "gsl-" func-string ">complex") + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "ptr") + (ptr o) i j)))) + + (defmethod set-element ((o ,class-object) i &optional j x) + (assert (typep x (element-type o))) + (assert (and (typep i 'integer) (>= i 0) (= j 0) (< j (size-cols o)))) + ,(if is-real + `(,(kmrcl:concat-symbol "gsl-matrix-" func-string "set") + (ptr o) i j x) + `(,(kmrcl:concat-symbol "with-" class-string "->gsl-" func-string + "ptr") (c-ptr x) + (,(kmrcl:concat-symbol "wrap-gsl-matrix-" func-string "set") + (ptr o) i j c-ptr))) + x) + + (defmethod set-all ((o ,class-object) x) + (assert (typep x (element-type o))) + ,(if is-real + `(,(kmrcl:concat-symbol "gsl-matrix-" func-string "set-all") + (ptr o) x) + `(,(kmrcl:concat-symbol "with-" class-string "->gsl-" func-string + "ptr") (c-ptr x) + (,(kmrcl:concat-symbol "wrap-gsl-matrix-" func-string "set-all") + (ptr o) c-ptr))) + o) + + (defmethod set-zero ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "set-zero") (ptr o)) + o) + + (defmethod set-identity ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "set-identity") + (ptr o)) + o) + + + (defmethod read-from-binary-file ((o ,class-object) file-name) + (let ((status)) + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-matrix-" func-string + "fread") c-file-name (ptr o)))) + (values o status))) + + (defmethod read-from-file ((o ,class-object) file-name) + (let ((status)) + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-matrix-" func-string + "fscanf") c-file-name (ptr o)))) + (values o status))) + + (defmethod write-to-binary-file (file-name (o ,class-object)) + (let ((status)) + ;; TODO: check if uffi:with-string returns a result, docs unclear. + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-matrix-" func-string + "fwrite") c-file-name (ptr o)))) + status)) + + (defmethod write-to-file (file-name (o ,class-object)) + (let ((status)) + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-matrix-" func-string + "fprintf") c-file-name (ptr o)))) + status)) + + (defmethod swap ((o1 ,class-object) (o2 ,class-object)) + (assert (and (= (size-rows o1) (size-rows o2)) + (= (size-cols o1) (size-cols o2)))) + (let ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "swap") (ptr o1) (ptr o2)))) + (values o1 status))) + + + (defmethod isnull ((o ,class-object)) + (1/0->t/nil (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "isnull") (ptr o)))) + + ,(when is-real + `(progn + (defmethod add ((o1 ,class-object) (o2 ,class-object)) + (assert (and (= (size-rows o1) (size-rows o2)) + (= (size-cols o1) (size-cols o2)))) + (let ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "add") (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod sub ((o1 ,class-object) (o2 ,class-object)) + (assert (and (= (size-rows o1) (size-rows o2)) + (= (size-cols o1) (size-cols o2)))) + (let ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "sub") (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod mul-elements ((o1 ,class-object) (o2 ,class-object)) + (assert (and (= (size-rows o1) (size-rows o2)) + (= (size-cols o1) (size-cols o2)))) + (let ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "mul-elements") + (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod div-elements ((o1 ,class-object) (o2 ,class-object)) + (assert (and (= (size-rows o1) (size-rows o2)) + (= (size-cols o1) (size-cols o2)))) + (let ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "div-elements") + (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod scale ((o ,class-object) x) + (assert (typep x (element-type o))) + ;; coerce to double-float looks wrong, but isn't. + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "scale") + (ptr o) (coerce x 'double-float))) + + (defmethod add-constant ((o ,class-object) x) + (assert (typep x (element-type o))) + ;; coerce to double-float looks wrong, but isn't. + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "add-constant") + (ptr o) (coerce x 'double-float))) + + (defmethod max-value ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "max") (ptr o))) + + (defmethod min-value ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "min") (ptr o))) + + + (defmethod max-index ((o ,class-object)) + (let ((i-ptr (uffi:allocate-foreign-object 'size-t)) + (j-ptr (uffi:allocate-foreign-object 'size-t))) + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "max-index") + (ptr o) i-ptr j-ptr) + (prog1 + (list (uffi:deref-pointer i-ptr 'size-t) + (uffi:deref-pointer j-ptr 'size-t)) + (uffi:free-foreign-object i-ptr) + (uffi:free-foreign-object j-ptr)))) + + (defmethod min-index ((o ,class-object)) + (let ((i-ptr (uffi:allocate-foreign-object 'size-t)) + (j-ptr (uffi:allocate-foreign-object 'size-t))) + (,(kmrcl:concat-symbol "gsl-matrix-" func-string "min-index") + (ptr o) i-ptr j-ptr) + (prog1 + (list (uffi:deref-pointer i-ptr 'size-t) + (uffi:deref-pointer j-ptr 'size-t)) + (uffi:free-foreign-object i-ptr) + (uffi:free-foreign-object j-ptr)))) + + (defmethod min-max-indicies ((o ,class-object)) + (list (min-index o) (max-index o))) + + (defmethod min-max-values ((o ,class-object)) + (destructuring-bind ((i-min j-min) (i-max j-max)) + (min-max-indicies o) + (list (get-element o i-min j-min) + (get-element o i-max j-max)))) + )) + ))) -;; Function: gsl_vector_view gsl_matrix_superdiagonal (gsl_matrix * m, size_t k) -;; Function: gsl_vector_const_view gsl_matrix_const_superdiagonal (const gsl_matrix * m, size_t k) -;; Function: int gsl_matrix_memcpy (gsl_matrix * dest, const gsl_matrix * src) +(def-matrix-methods% "integer" "int-") +(def-matrix-methods% "single-float" "float-") +(def-matrix-methods% "double-float" "") +(def-matrix-methods% "complex-single-float" "complex-float-") +(def-matrix-methods% "complex-double-float" "complex-") + + +(defun make-matrix (size-rows size-cols + &key (element-type 'double-float) initial-element + initial-contents from-file from-binary-file) + (assert (and (typep size-rows 'integer) (> size-rows 0) )) + (assert (and (typep size-cols 'integer) (> size-cols 0) )) + (assert (find element-type '(integer single-float double-float + (complex (single-float)) + (complex (double-float))) :test #'equal)) + (let ((m (cond + ((eq element-type 'integer) + (make-instance 'gsl-matrix-integer + :size-rows size-rows :size-cols size-cols + :element-type element-type)) + ((eq element-type 'double-float) + (make-instance 'gsl-matrix-double-float + :size-rows size-rows :size-cols size-cols + :element-type element-type)) + ((eq element-type 'single-float) + (make-instance 'gsl-matrix-single-float + :size-rows size-rows :size-cols size-cols + :element-type element-type)) + ((equal element-type '(complex (double-float))) + (make-instance 'gsl-matrix-complex-double-float + :size-rows size-rows :size-cols size-cols + :element-type element-type)) + ((equal element-type '(complex (single-float))) + (make-instance 'gsl-matrix-complex-single-float + :size-rows size-rows :size-cols size-cols + :element-type element-type)) + (t + (error "should never get here."))))) + (alloc m) + (cond + ((and initial-element initial-contents from-file from-binary-file) + (error "can only define one of the keys: initial-element, initial-contents, from-file, from-binary-file.")) + (initial-element + (set-all m initial-element)) + (initial-contents + (cond + ((arrayp initial-contents) + (dotimes (i size-rows) + (dotimes (j size-cols) + (set-element m i j (aref initial-contents i j))))) + (t + (error "initial-contents must be an array.")))) + (from-file + (read-from-file m from-file)) + (from-binary-file + (read-from-binary-file m from-binary-file))) + m)) + + +(defmacro with-matrix + ((m size-rows size-cols &key element-type initial-element initial-contents + from-file from-binary-file) &body body) + `(let ((,m (make-matrix ,size-rows ,size-cols + :element-type (or ,element-type 'double-float) + :initial-element ,initial-element + :initial-contents ,initial-contents + :from-file ,from-file + :from-binary-file ,from-binary-file))) + (unwind-protect + (progn ,@body) + (free ,m)))) + + +(defmacro def-matrix-copy-method% (class-string func-string) + (let ((class-object (kmrcl:concat-symbol "gsl-matrix-" class-string))) + `(defmethod copy ((o ,class-object)) + (let* ((o-copy (make-matrix (size-rows o) (size-cols o) + :element-type (element-type o))) + (status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "memcpy") (ptr o-copy) (ptr o)))) + (values o-copy status))))) + +(def-matrix-copy-method% "integer" "int-") +(def-matrix-copy-method% "single-float" "float-") +(def-matrix-copy-method% "double-float" "") +(def-matrix-copy-method% "complex-single-float" "complex-float-") +(def-matrix-copy-method% "complex-double-float" "complex-") + + +(defmacro with-matrix-copy ((m-dest m-src) &body body) + `(let ((,m-dest (copy ,m-src))) + (unwind-protect + ,@body + (free ,m-dest)))) + + +(defun gsl-matrix->lisp-array (m) + (let ((a (make-array (list (size-rows m) (size-cols m)) + :element-type (element-type m)))) + (dotimes (i (size-rows m)) + (dotimes (j (size-cols m)) + (setf (aref a i j) (get-element m i j)))) + a)) -;; Function: int gsl_matrix_swap (gsl_matrix * m1, gsl_matrix * m2) ;; Function: int gsl_matrix_get_row (gsl_vector * v, const gsl_matrix * m, size_t i) @@ -150,30 +547,3 @@ ;; Function: int gsl_matrix_transpose_memcpy (gsl_matrix * dest, const gsl_matrix * src) ;; Function: int gsl_matrix_transpose (gsl_matrix * m) - -;; Function: int gsl_matrix_add (gsl_matrix * a, const gsl_matrix * b) - -;; Function: int gsl_matrix_sub (gsl_matrix * a, const gsl_matrix * b) - -;; Function: int gsl_matrix_mul_elements (gsl_matrix * a, const gsl_matrix * b) - -;; Function: int gsl_matrix_div_elements (gsl_matrix * a, const gsl_matrix * b) - -;; Function: int gsl_matrix_scale (gsl_matrix * a, const double x) - -;; Function: int gsl_matrix_add_constant (gsl_matrix * a, const double x) - -;; Function: double gsl_matrix_max (const gsl_matrix * m) - -;; Function: double gsl_matrix_min (const gsl_matrix * m) - -;; Function: void gsl_matrix_minmax (const gsl_matrix * m, double * min_out, double * max_out) - -;; Function: void gsl_matrix_max_index (const gsl_matrix * m, size_t * imax, size_t * jmax) - -;; Function: void gsl_matrix_min_index (const gsl_matrix * m, size_t * imax, size_t * jmax) - -;; Function: void gsl_matrix_minmax_index (const gsl_matrix * m, size_t * imin, size_t * imax) - -;; Function: int gsl_matrix_isnull (const gsl_matrix * m) -

1 0

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

18 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv23780 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 18 03:06:38 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.15 cl-gsl/ChangeLog:1.16 --- cl-gsl/ChangeLog:1.15 Sun Apr 10 04:34:50 2005 +++ cl-gsl/ChangeLog Mon Apr 18 03:06:38 2005 @@ -1,3 +1,20 @@ +2005-04-18 Edgar Denny <edgardenny(a)comcast.net> + + * test/test-vector.lisp: + A few changes since vector.lisp new uses classes rather than + structures. + + * vector.lisp: + Ripped out struct implementation and replaced with classes. + + * package.lisp: Add matrix package. + + * matrix.lisp: Initial checkin. + + * ffi.lisp: Add matrix types. + + * cl-gsl.asd: add matrix to defsytem. + 2005-04-10 Edgar Denny <edgardenny(a)comcast.net> * test/test-vector.lisp:

1 0

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

18 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv23118 Modified Files: test-vector.lisp Log Message: A few changes since vector.lisp new uses classes rather than structures. Date: Mon Apr 18 03:00:12 2005 Author: edenny Index: cl-gsl/test/test-vector.lisp diff -u cl-gsl/test/test-vector.lisp:1.3 cl-gsl/test/test-vector.lisp:1.4 --- cl-gsl/test/test-vector.lisp:1.3 Sun Apr 10 04:32:24 2005 +++ cl-gsl/test/test-vector.lisp Mon Apr 18 03:00:12 2005 @@ -26,8 +26,8 @@ #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type 'double-float))) (prog1 - (and (= (gsl-vector:gsl-vec-size v) 5) - (eq (gsl-vector:gsl-vec-element-type v) 'double-float)) + (and (= (gsl-vector::size v) 5) + (eq (gsl-vector::element-type v) 'double-float)) (gsl-vector:free v))))) @@ -36,8 +36,8 @@ #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type 'single-float))) (prog1 - (and (= (gsl-vector:gsl-vec-size v) 5) - (eq (gsl-vector:gsl-vec-element-type v) 'single-float)) + (and (= (gsl-vector::size v) 5) + (eq (gsl-vector::element-type v) 'single-float)) (gsl-vector:free v))))) (deftest "make-vector-integer" :category +vector+ @@ -45,18 +45,18 @@ #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type 'integer))) (prog1 - (and (= (gsl-vector:gsl-vec-size v) 5) - (eq (gsl-vector:gsl-vec-element-type v) 'integer)) + (and (= (gsl-vector::size v) 5) + (eq (gsl-vector::element-type v) 'integer)) (gsl-vector:free v))))) -v(deftest "make-vector-complex-double-float" :category +vector+ +(deftest "make-vector-complex-double-float" :category +vector+ :test-fn #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type '(complex (double-float))))) (prog1 - (and (= (gsl-vector:gsl-vec-size v) 5) - (equal (gsl-vector:gsl-vec-element-type v) + (and (= (gsl-vector::size v) 5) + (equal (gsl-vector::element-type v) '(complex (double-float)))) (gsl-vector:free v))))) @@ -66,8 +66,8 @@ (let ((v (gsl-vector:make-vector 5 :element-type '(complex (single-float))))) (prog1 - (and (= (gsl-vector:gsl-vec-size v) 5) - (equal (gsl-vector:gsl-vec-element-type v) + (and (= (gsl-vector::size v) 5) + (equal (gsl-vector::element-type v) '(complex (single-float)))) (gsl-vector:free v)))))

1 0

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

18 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv22808 Modified Files: vector.lisp Log Message: Ripped out struct implementation and replaced with classes. Date: Mon Apr 18 02:55:10 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.7 cl-gsl/vector.lisp:1.8 --- cl-gsl/vector.lisp:1.7 Sun Apr 10 04:31:06 2005 +++ cl-gsl/vector.lisp Mon Apr 18 02:55:09 2005 @@ -19,11 +19,28 @@ (in-package #:cl-gsl-vector) + +(defclass gsl-vector () + ((ptr :accessor ptr :initarg :ptr) + (size :accessor size :initarg :size) + (element-type :accessor element-type :initarg :element-type))) + + +(defclass gsl-vector-double-float (gsl-vector) ()) +(defclass gsl-vector-single-float (gsl-vector) ()) +(defclass gsl-vector-integer (gsl-vector) ()) +(defclass gsl-vector-complex-double-float (gsl-vector) ()) +(defclass gsl-vector-complex-single-float (gsl-vector) ()) + + (defmacro def-vector-type-funcs% (typ) (let ((type-ptr) (type-val) (type-val-ptr) - (type-string)) + (type-string) + (is-real (or (eq typ 'double-float) + (eq typ 'single-float) + (eq typ 'integer)))) (cond ((eq typ 'double-float) (setq type-ptr 'gsl-vector-ptr) @@ -107,92 +124,6 @@ ((v1 ,type-ptr)) :int) - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_add") - ((va ,type-ptr) - (vb ,type-ptr)) - :int)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_sub") - ((va ,type-ptr) - (vb ,type-ptr)) - :int)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_mul") - ((va ,type-ptr) - (vb ,type-ptr)) - :int)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_div") - ((va ,type-ptr) - (vb ,type-ptr)) - :int)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") - ((vec ,type-ptr) - ;; seems odd that this is :double for all types - (x :double)) - :int)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string - "gsl_" type-string "_add_constant") - ((vec ,type-ptr) - ;; and again, :double for all types - (x :double)) - :int)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max") - ((vec ,type-ptr)) - ,type-val)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min") - ((vec ,type-ptr)) - ,type-val)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax") - ((vec ,type-ptr) - (min ,type-val-ptr) - (max ,type-val-ptr)) - :void)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index") - ((vec ,type-ptr)) - size-t)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index") - ((vec ,type-ptr)) - size-t)) - - ,(unless (or (equal typ '(complex (double-float))) - (equal typ '(complex (single-float)))) - `(defun-foreign ,(concatenate 'string - "gsl_" type-string "_minmax_index") - ((vec ,type-ptr) - (min size-t-ptr) - (max size-t-ptr)) - :void)) - (defun-foreign ,(concatenate 'string "gsl_" type-string "_isnull") ((vec ,type-ptr)) :int) @@ -230,40 +161,95 @@ (offset size-t) (stride size-t) (n size-t)) - ,type-ptr)))) + ,type-ptr) + ,(when is-real + `(progn + (defun-foreign ,(concatenate 'string "gsl_" type-string "_add") + ((va ,type-ptr) + (vb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_sub") + ((va ,type-ptr) + (vb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_mul") + ((va ,type-ptr) + (vb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_div") + ((va ,type-ptr) + (vb ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") + ((vec ,type-ptr) + ;; seems odd that this is :double for all types + (x :double)) + :int) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_add_constant") + ((vec ,type-ptr) + ;; and again, :double for all types + (x :double)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_max") + ((vec ,type-ptr)) + ,type-val) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_min") + ((vec ,type-ptr)) + ,type-val) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax") + ((vec ,type-ptr) + (min ,type-val-ptr) + (max ,type-val-ptr)) + :void) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_max_index") + ((vec ,type-ptr)) + size-t) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_min_index") + ((vec ,type-ptr)) + size-t) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_minmax_index") + ((vec ,type-ptr) + (min size-t-ptr) + (max size-t-ptr)) + :void) + )) + + ,(when (not is-real) + `(progn + (defun-foreign ,(concatenate 'string "gsl_" type-string "_ptr") + ((v ,type-ptr) + (i size-t)) + (* ,type-val)) + + (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_set") + ((v ,type-ptr) + (i size-t) + (z (* ,type-val))) + :void) + + (defun-foreign ,(concatenate 'string + "wrap_gsl_" type-string "_set_all") + ((v ,type-ptr) + (z (* ,type-val))) + :void))) + ))) -(defun-foreign "gsl_vector_complex_float_ptr" - ((v gsl-vector-complex-float-ptr) - (i size-t)) - (* gsl-complex-float)) - -(defun-foreign "gsl_vector_complex_ptr" - ((v gsl-vector-complex-ptr) - (i size-t)) - (* gsl-complex)) - -(defun-foreign "wrap_gsl_vector_complex_float_set" - ((v gsl-vector-complex-float-ptr) - (i size-t) - (z (* gsl-complex-float))) - :void) - -(defun-foreign "wrap_gsl_vector_complex_set" - ((v gsl-vector-complex-ptr) - (i size-t) - (z (* gsl-complex))) - :void) - -(defun-foreign "wrap_gsl_vector_complex_float_set_all" - ((v gsl-vector-complex-float-ptr) - (z (* gsl-complex-float))) - :void) - -(defun-foreign "wrap_gsl_vector_complex_set_all" - ((v gsl-vector-complex-ptr) - (z (* gsl-complex))) - :void) (def-vector-type-funcs% double-float) (def-vector-type-funcs% single-float) @@ -271,221 +257,252 @@ (def-vector-type-funcs% (complex (double-float))) (def-vector-type-funcs% (complex (single-float))) -(defstruct gsl-vec - ;; TODO: print-function ? - ptr - size - element-type) - -(defun alloc (v) - (assert (eq 'gsl-vec (type-of v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (setf (gsl-vec-ptr v) (gsl-vector-int-alloc (gsl-vec-size v)))) - ((eq (gsl-vec-element-type v) 'single-float) - (setf (gsl-vec-ptr v) (gsl-vector-float-alloc (gsl-vec-size v)))) - ((eq (gsl-vec-element-type v) 'double-float) - (setf (gsl-vec-ptr v) (gsl-vector-alloc (gsl-vec-size v)))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (setf (gsl-vec-ptr v) (gsl-vector-complex-float-alloc (gsl-vec-size v)))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (setf (gsl-vec-ptr v) (gsl-vector-complex-alloc (gsl-vec-size v)))) - (t - (error "No matching type")))) - - -(defun free (v) - (assert (eq 'gsl-vec (type-of v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-free (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-free (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-free (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (gsl-vector-complex-float-free (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-free (gsl-vec-ptr v))) - (t - (error "No matching type"))) - (setf (gsl-vec-ptr v) nil) - (setf (gsl-vec-size v) nil) - (setf (gsl-vec-element-type v) nil)) - - -(defun get-element (v i) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep i 'integer)) - (assert (< i (gsl-vec-size v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-get (gsl-vec-ptr v) i)) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-get (gsl-vec-ptr v) i)) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-get (gsl-vec-ptr v) i)) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (gsl-complex-float->complex - (gsl-vector-complex-float-ptr (gsl-vec-ptr v) i))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-complex->complex (gsl-vector-complex-ptr (gsl-vec-ptr v) i))) - (t - (error "No matching type")))) - - -;; TODO: make a (setf (get-element v i) x) version. -(defun set-element (v i x) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep x (gsl-vec-element-type v))) - (assert (typep i 'integer)) - (assert (< i (gsl-vec-size v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-set (gsl-vec-ptr v) i x)) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-set (gsl-vec-ptr v) i x)) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-set (gsl-vec-ptr v) i x)) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (with-complex-single-float->gsl-complex-float-ptr (c-ptr x) - (wrap-gsl-vector-complex-float-set (gsl-vec-ptr v) i c-ptr))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (with-complex-double-float->gsl-complex-ptr (c-ptr x) - (wrap-gsl-vector-complex-set (gsl-vec-ptr v) i c-ptr))) - (t - (error "No matching type"))) - v) - - -(defun set-all (v x) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep x (gsl-vec-element-type v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-set-all (gsl-vec-ptr v) x)) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-set-all (gsl-vec-ptr v) x)) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-set-all (gsl-vec-ptr v) x)) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (with-complex-single-float->gsl-complex-float-ptr (c-ptr x) - (wrap-gsl-vector-complex-float-set-all (gsl-vec-ptr v) c-ptr))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (with-complex-double-float->gsl-complex-ptr (c-ptr x) - (wrap-gsl-vector-complex-set-all (gsl-vec-ptr v) c-ptr))) - (t - (error "No matching type"))) - v) - - -(defun set-zero (v) - (assert (eq 'gsl-vec (type-of v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-set-zero (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-set-zero (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-set-zero (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (gsl-vector-complex-float-set-zero (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-set-zero (gsl-vec-ptr v))) - (t - (error "No matching type"))) - v) - - -(defun set-basis (v i) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep i 'integer)) - (assert (< i (gsl-vec-size v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-set-basis (gsl-vec-ptr v) i)) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-set-basis (gsl-vec-ptr v) i)) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-set-basis (gsl-vec-ptr v) i)) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (gsl-vector-complex-float-set-basis (gsl-vec-ptr v) i)) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-set-basis (gsl-vec-ptr v) i)) - (t - (error "No matching type"))) - v) - - -(defun read-from-binary-file (v file-name size) - (assert (eq 'gsl-vec (type-of v))) - (assert (<= size (gsl-vec-size v))) - (let ((status)) - (uffi:with-cstring (c-file-name file-name) - (setq status - (cond - ((eq (gsl-vec-element-type v) 'integer) - (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-fread c-file-name (gsl-vec-ptr v))) - (t - (error "No matching type"))))) - (values v status))) - - -(defun read-from-file (v file-name size) - (assert (eq 'gsl-vec (type-of v))) - (assert (<= size (gsl-vec-size v))) - (let ((status)) - (uffi:with-cstring (c-file-name file-name) - (setq status - (cond - ((eq (gsl-vec-element-type v) 'integer) - (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-fscanf c-file-name - (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v))) - (t - (error "No matching type"))))) - (values v status))) + +(defmacro def-vector-methods% (class-string func-string) + (let ((class-object (kmrcl:concat-symbol "gsl-vector-" class-string)) + (is-real (or (string= class-string "integer") + (string= class-string "single-float") + (string= class-string "double-float")))) + `(progn + + (defmethod alloc ((o ,class-object)) + (setf (ptr o) (,(kmrcl:concat-symbol "gsl-vector-" func-string "alloc") + (size o))) + o) + + (defmethod free ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-vector-" func-string "free") (ptr o)) + (setf (ptr o) nil) + (setf (size o) nil) + (setf (element-type o) nil)) + + + (defmethod get-element ((o ,class-object) i) + (assert (typep i 'integer)) + (assert (and (>= i 0) (complex") + (,(kmrcl:concat-symbol "gsl-vector-" func-string "ptr") + (ptr o) i)))) + + (defmethod set-element ((o ,class-object) i x) + (assert (typep i 'integer)) + (assert (typep x (element-type o))) + (assert (and (>= i 0) (gsl-" func-string + "ptr") (c-ptr x) + (,(kmrcl:concat-symbol "wrap-gsl-vector-" func-string "set") + (ptr o) i c-ptr))) + x) + + (defmethod set-all ((o ,class-object) x) + (assert (typep x (element-type o))) + ,(if is-real + `(,(kmrcl:concat-symbol "gsl-vector-" func-string "set-all") + (ptr o) x) + `(,(kmrcl:concat-symbol "with-" class-string "->gsl-" func-string + "ptr") (c-ptr x) + (,(kmrcl:concat-symbol "wrap-gsl-vector-" func-string "set-all") + (ptr o) c-ptr))) + o) + + (defmethod set-zero ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-vector-" func-string "set-zero") (ptr o)) + o) + + + (defmethod set-basis ((o ,class-object) i) + (assert (typep i 'integer)) + (assert (and (>= i 0) ( size 0) (<= size (size o)))) + (let ((status)) + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-vector-" func-string + "fread") c-file-name (ptr o)))) + (values o status))) + + (defmethod read-from-file ((o ,class-object) file-name size) + (assert (and (> size 0) (<= size (size o)))) + (let ((status)) + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-vector-" func-string + "fscanf") c-file-name (ptr o)))) + (values o status))) + + (defmethod write-to-binary-file (file-name (o ,class-object)) + (let ((status)) + ;; TODO: check if uffi:with-string returns a result, docs unclear. + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-vector-" func-string + "fwrite") c-file-name (ptr o)))) + status)) + + (defmethod write-to-file (file-name (o ,class-object)) + (let ((status)) + (uffi:with-cstring (c-file-name file-name) + (setq status + (,(kmrcl:concat-symbol "wrap-gsl-vector-" func-string + "fprintf") c-file-name (ptr o)))) + status)) + + (defmethod swap ((o1 ,class-object) (o2 ,class-object)) + (assert (= (size o1) (size o2))) + (let ((status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "swap") (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod swap-elements ((o ,class-object) i j) + (assert (and (typep i 'integer) (>= i 0) (= j 0) (< j (size o)))) + (let ((status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "swap-elements") (ptr o) i j))) + (values o status))) + + (defmethod reverse-vector ((o ,class-object)) + (let ((status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "reverse") (ptr o)))) + (values o status))) + + + (defmethod isnull ((o ,class-object)) + (1/0->t/nil (,(kmrcl:concat-symbol "gsl-vector-" func-string + "isnull") (ptr o)))) + + ,(when is-real + `(progn + (defmethod add ((o1 ,class-object) (o2 ,class-object)) + (assert (= (size o1) (size o2))) + (let ((status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "add") (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod sub ((o1 ,class-object) (o2 ,class-object)) + (assert (= (size o1) (size o2))) + (let ((status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "sub") (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod mul ((o1 ,class-object) (o2 ,class-object)) + (assert (= (size o1) (size o2))) + (let ((status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "mul") (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod div ((o1 ,class-object) (o2 ,class-object)) + (assert (= (size o1) (size o2))) + (let ((status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "div") (ptr o1) (ptr o2)))) + (values o1 status))) + + (defmethod scale ((o ,class-object) x) + (assert (typep x (element-type o))) + ;; coerce to double-float looks wrong, but isn't. + (,(kmrcl:concat-symbol "gsl-vector-" func-string "scale") + (ptr o) (coerce x 'double-float))) + + (defmethod add-constant ((o ,class-object) x) + (assert (typep x (element-type o))) + ;; coerce to double-float looks wrong, but isn't. + (,(kmrcl:concat-symbol "gsl-vector-" func-string "add-constant") + (ptr o) (coerce x 'double-float))) + + (defmethod max-value ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-vector-" func-string "max") (ptr o))) + + (defmethod min-value ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-vector-" func-string "min") (ptr o))) + + (defmethod max-index ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-vector-" func-string "max-index") + (ptr o))) + + (defmethod min-index ((o ,class-object)) + (,(kmrcl:concat-symbol "gsl-vector-" func-string "min-index") + (ptr o))) + + (defmethod min-max-indicies ((o ,class-object)) + (let ((min-ptr (uffi:allocate-foreign-object 'size-t)) + (max-ptr (uffi:allocate-foreign-object 'size-t))) + (,(kmrcl:concat-symbol "gsl-vector-" func-string + "minmax-index") + (ptr o) min-ptr max-ptr) + (prog1 + (list (uffi:deref-pointer min-ptr 'size-t) + (uffi:deref-pointer max-ptr 'size-t)) + (uffi:free-foreign-object min-ptr) + (uffi:free-foreign-object max-ptr)))) + + (defmethod min-max-values ((o ,class-object)) + (destructuring-bind (min-index max-index) + (min-max-indicies o) + (list (get-element o min-index) + (get-element o max-index)))) + + ))))) + + +(def-vector-methods% "integer" "int-") +(def-vector-methods% "single-float" "float-") +(def-vector-methods% "double-float" "") +(def-vector-methods% "complex-single-float" "complex-float-") +(def-vector-methods% "complex-double-float" "complex-") (defun make-vector (size &key (element-type 'double-float) initial-element initial-contents from-file from-binary-file) - (assert (typep size 'integer)) + (assert (and (typep size 'integer) (> size 0) )) (assert (find element-type '(integer single-float double-float (complex (single-float)) (complex (double-float))) :test #'equal)) - (let ((v (make-gsl-vec :size size :element-type element-type))) - (setf (gsl-vec-ptr v) (alloc v)) + (let ((v (cond + ((eq element-type 'integer) + (make-instance 'gsl-vector-integer + :size size :element-type element-type)) + ((eq element-type 'double-float) + (make-instance 'gsl-vector-double-float + :size size :element-type element-type)) + ((eq element-type 'single-float) + (make-instance 'gsl-vector-single-float + :size size :element-type element-type)) + ((equal element-type '(complex (double-float))) + (make-instance 'gsl-vector-complex-double-float + :size size :element-type element-type)) + ((equal element-type '(complex (single-float))) + (make-instance 'gsl-vector-complex-single-float + :size size :element-type element-type)) + (t + (error "should never get here."))))) + (alloc v) (cond ((and initial-element initial-contents from-file from-binary-file) (error "can only define one of the keys: initial-element, initial-contents, from-file, from-binary-file.")) (initial-element - (gsl-vector:set-all v initial-element)) + (set-all v initial-element)) (initial-contents (cond ((listp initial-contents) (do ((x initial-contents (cdr x)) (i 0 (1+ i))) ((= i size)) - (gsl-vector:set-element v i (car x)))) + (set-element v i (car x)))) ((vectorp initial-contents) (do ((i 0 (1+ i))) ((= i size)) - (gsl-vector:set-element v i (aref initial-contents i)))) + (set-element v i (aref initial-contents i)))) (t (error "initial-contents must be either a list or a vector.")))) (from-file @@ -509,132 +526,19 @@ (free ,vec)))) -(defun write-to-binary-file (file-name v) - (assert (eq 'gsl-vec (type-of v))) - (let ((status)) - ;; TODO: check if uffi:with-string returns a result, docs unclear. - (uffi:with-cstring (c-file-name file-name) - (setq status - (cond - ((eq (gsl-vec-element-type v) 'integer) - (wrap-gsl-vector-int-fwrite c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (wrap-gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (wrap-gsl-vector-fwrite c-file-name (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-fwrite c-file-name - (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v))) - (t - (error "No matching type"))))) - status)) - - -(defun write-to-file (file-name v) - (assert (eq 'gsl-vec (type-of v))) - (let ((status)) - (uffi:with-cstring (c-file-name file-name) - (setq status - (cond - ((eq (gsl-vec-element-type v) 'integer) - (wrap-gsl-vector-int-fprintf c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (wrap-gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (wrap-gsl-vector-fprintf c-file-name (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-fprintf c-file-name - (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v))) - (t - (error "No matching type"))))) - status)) - - -(defun subvector (v offset n) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep offset 'integer)) - (assert (typep n 'integer)) - (assert (< (+ offset n) (gsl-vec-size v))) - ;; use make-gsl-vec here rather than make-vector - we do not want to - ;; allocate any foreign memory for the subvector. - (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v)))) - (setf (gsl-vec-ptr v-sub) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (wrap-gsl-vector-int-subvector (gsl-vec-ptr v) offset n)) - ((eq (gsl-vec-element-type v) 'single-float) - (wrap-gsl-vector-float-subvector (gsl-vec-ptr v) offset n)) - ((eq (gsl-vec-element-type v) 'double-float) - (wrap-gsl-vector-subvector (gsl-vec-ptr v) offset n)) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-subvector (gsl-vec-ptr v) offset n)) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-subvector (gsl-vec-ptr v) offset n)) - (t - (error "No matching type")))) - v-sub)) - - -(defun subvector-with-stride (v offset stride n) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep offset 'integer)) - (assert (typep stride 'integer)) - (assert (typep n 'integer)) - (assert (< (* (+ offset n) stride) (gsl-vec-size v))) - ;; use make-gsl-vec here rather than make-vector - we do not want to - ;; allocate any foreign memory for the subvector. - (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v)))) - (setf (gsl-vec-ptr v-sub) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (wrap-gsl-vector-int-subvector-with-stride (gsl-vec-ptr v) - offset stride n)) - ((eq (gsl-vec-element-type v) 'single-float) - (wrap-gsl-vector-float-subvector-with-stride (gsl-vec-ptr v) - offset stride n)) - ((eq (gsl-vec-element-type v) 'double-float) - (wrap-gsl-vector-subvector-with-stride (gsl-vec-ptr v) - offset stride n)) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (wrap-gsl-vector-complex-float-subvector-with-stride - (gsl-vec-ptr v) offset stride n)) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (wrap-gsl-vector-complex-subvector-with-stride (gsl-vec-ptr v) - offset stride n)) - (t - (error "No matching type")))) - v-sub)) - - -(defun copy (v-src) - (assert (eq 'gsl-vec (type-of v-src))) - (let* ((v-dest (make-vector (gsl-vec-size v-src) - :element-type (gsl-vec-element-type v-src))) - (status (cond - ((eq (gsl-vec-element-type v-src) 'integer) - (gsl-vector-int-memcpy (gsl-vec-ptr v-dest) - (gsl-vec-ptr v-src))) - ((eq (gsl-vec-element-type v-src) 'single-float) - (gsl-vector-float-memcpy (gsl-vec-ptr v-dest) - (gsl-vec-ptr v-src))) - ((eq (gsl-vec-element-type v-src) 'double-float) - (gsl-vector-memcpy (gsl-vec-ptr v-dest) - (gsl-vec-ptr v-src))) - ((equal (gsl-vec-element-type v-src) - '(complex (single-float))) - (gsl-vector-complex-float-memcpy (gsl-vec-ptr v-dest) - (gsl-vec-ptr v-src))) - ((equal (gsl-vec-element-type v-src) - '(complex (double-float))) - (gsl-vector-complex-memcpy (gsl-vec-ptr v-dest) - (gsl-vec-ptr v-src))) - (t - (error "No matching type"))))) - (values v-dest status))) +(defmacro def-vector-copy-method% (class-string func-string) + (let ((class-object (kmrcl:concat-symbol "gsl-vector-" class-string))) + `(defmethod copy ((o ,class-object)) + (let* ((o-copy (make-vector (size o) :element-type (element-type o))) + (status (,(kmrcl:concat-symbol "gsl-vector-" func-string + "memcpy") (ptr o-copy) (ptr o)))) + (values o-copy status))))) + +(def-vector-copy-method% "integer" "int-") +(def-vector-copy-method% "single-float" "float-") +(def-vector-copy-method% "double-float" "") +(def-vector-copy-method% "complex-single-float" "complex-float-") +(def-vector-copy-method% "complex-double-float" "complex-") (defmacro with-vector-copy ((vec-dest vec-src) &body body) @@ -644,278 +548,9 @@ (free ,vec-dest)))) -(defun swap (va vb) - (assert (eq 'gsl-vec (type-of va))) - (assert (eq 'gsl-vec (type-of vb))) - (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) - (assert (= (gsl-vec-size va) (gsl-vec-size vb))) - (let ((status - (cond - ((eq (gsl-vec-element-type va) 'integer) - (gsl-vector-int-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'single-float) - (gsl-vector-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'double-float) - (gsl-vector-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((equal (gsl-vec-element-type va) '(complex (single-float))) - (gsl-vector-complex-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((equal (gsl-vec-element-type va) '(complex (double-float))) - (gsl-vector-complex-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - (t - (error "No matching type"))))) - (values va status))) - - -(defun swap-elements (v i j) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep i 'integer)) - (assert (typep j 'integer)) - (assert (< i (gsl-vec-size v))) - (assert (< j (gsl-vec-size v))) - (let ((status - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-swap-elements (gsl-vec-ptr v) i j)) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-swap-elements (gsl-vec-ptr v) i j)) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-swap-elements (gsl-vec-ptr v) i j)) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (gsl-vector-complex-float-swap-elements (gsl-vec-ptr v) i j)) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-swap-elements (gsl-vec-ptr v) i j)) - (t - (error "No matching type"))))) - (values v status))) - - -(defun reverse-vector (v) - (assert (eq 'gsl-vec (type-of v))) - (let ((status - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-reverse (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-reverse (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-reverse (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (gsl-vector-complex-float-reverse (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-reverse (gsl-vec-ptr v))) - (t - (error "No matching type"))))) - (values v status))) - - -(defun add (va vb) - (assert (eq 'gsl-vec (type-of va))) - (assert (eq 'gsl-vec (type-of vb))) - (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) - (assert (= (gsl-vec-size va) (gsl-vec-size vb))) - (let ((status - (cond - ((eq (gsl-vec-element-type va) 'integer) - (gsl-vector-int-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'single-float) - (gsl-vector-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'double-float) - (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - (t - (error "No matching type"))))) - (values va status))) - - -(defun sub (va vb) - (assert (eq 'gsl-vec (type-of va))) - (assert (eq 'gsl-vec (type-of vb))) - (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) - (assert (= (gsl-vec-size va) (gsl-vec-size vb))) - (let ((status - (cond - ((eq (gsl-vec-element-type va) 'integer) - (gsl-vector-int-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'single-float) - (gsl-vector-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'double-float) - (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - (t - (error "No matching type"))))) - (values va status))) - - -(defun mul (va vb) - (assert (eq 'gsl-vec (type-of va))) - (assert (eq 'gsl-vec (type-of vb))) - (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) - (assert (= (gsl-vec-size va) (gsl-vec-size vb))) - (let ((status - (cond - ((eq (gsl-vec-element-type va) 'integer) - (gsl-vector-int-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'single-float) - (gsl-vector-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'double-float) - (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - (t - (error "No matching type"))))) - (values va status))) - - -(defun div (va vb) - (assert (eq 'gsl-vec (type-of va))) - (assert (eq 'gsl-vec (type-of vb))) - (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb))) - (assert (= (gsl-vec-size va) (gsl-vec-size vb))) - (let ((status - (cond - ((eq (gsl-vec-element-type va) 'integer) - (gsl-vector-int-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'single-float) - (gsl-vector-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ((eq (gsl-vec-element-type va) 'double-float) - (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - (t - (error "No matching type"))))) - (values va status))) - - -(defun scale (v x) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep x (gsl-vec-element-type v))) - (let ((status - (cond - ((eq (gsl-vec-element-type v) 'integer) - ;; coerce to double-float looks wrong, but isn't. - (gsl-vector-int-scale (gsl-vec-ptr v) (coerce x 'double-float))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-scale (gsl-vec-ptr v) (coerce x 'double-float))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-scale (gsl-vec-ptr v) x)) - (t - (error "No matching type"))))) - (values v status))) - - -(defun add-constant (v x) - (assert (eq 'gsl-vec (type-of v))) - (assert (typep x (gsl-vec-element-type v))) - (let ((status - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-add-constant (gsl-vec-ptr v) - (coerce x 'double-float))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-add-constant (gsl-vec-ptr v) - (coerce x 'double-float))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-add-constant (gsl-vec-ptr v) x)) - (t - (error "No matching type"))))) - (values v status))) - - -(defun max-value (v) - (assert (eq 'gsl-vec (type-of v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-max (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-max (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-max (gsl-vec-ptr v))) - (t - (error "No matching type")))) - - -(defun min-value (v) - (assert (eq 'gsl-vec (type-of v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-min (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-min (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-min (gsl-vec-ptr v))) - (t - (error "No matching type")))) - - -(defun max-index (v) - (assert (eq 'gsl-vec (type-of v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-max-index (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-max-index (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-max-index (gsl-vec-ptr v))) - (t - (error "No matching type")))) - - -(defun min-index (v) - (assert (eq 'gsl-vec (type-of v))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-min-index (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-min-index (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-min-index (gsl-vec-ptr v))) - (t - (error "No matching type")))) - - -(defun min-max-indicies (v) - (assert (eq 'gsl-vec (type-of v))) - (let ((min-ptr (uffi:allocate-foreign-object 'size-t)) - (max-ptr (uffi:allocate-foreign-object 'size-t))) - (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) - (t - (error "No matching type"))) - (prog1 - (list (uffi:deref-pointer min-ptr 'size-t) - (uffi:deref-pointer max-ptr 'size-t)) - (uffi:free-foreign-object min-ptr) - (uffi:free-foreign-object max-ptr)))) - - -(defun min-max-values (v) - (assert (eq 'gsl-vec (type-of v))) - (destructuring-bind (min-index max-index) - (min-max-indicies v) - (list (get-element v min-index) - (get-element v max-index)))) - - -(defun isnull (v) - (assert (eq 'gsl-vec (type-of v))) - (1/0->t/nil (cond - ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-isnull (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'single-float) - (gsl-vector-float-isnull (gsl-vec-ptr v))) - ((eq (gsl-vec-element-type v) 'double-float) - (gsl-vector-isnull (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (single-float))) - (gsl-vector-complex-float-isnull (gsl-vec-ptr v))) - ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-isnull (gsl-vec-ptr v))) - (t - (error "No matching type"))))) - - (defun gsl->lisp-vector (v) - (assert (eq 'gsl-vec (type-of v))) - (let ((a (make-array (gsl-vec-size v) :element-type (gsl-vec-element-type v)))) - (dotimes (i (gsl-vec-size v) a) + (let ((a (make-array (size v) :element-type (element-type v)))) + (dotimes (i (size v) a) (setf (aref a i) (get-element v i))))) ;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v)

1 0

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

18 Apr '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv22754 Modified Files: package.lisp Log Message: Add matrix package. Date: Mon Apr 18 02:52:59 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.6 cl-gsl/package.lisp:1.7 --- cl-gsl/package.lisp:1.6 Sun Apr 10 04:29:21 2005 +++ cl-gsl/package.lisp Mon Apr 18 02:52:59 2005 @@ -135,3 +135,10 @@ #:isnull #:gsl->lisp-vector )) + +(defpackage #:cl-gsl-matrix + (:nicknames #:gsl-matrix) + (:use #:cl #:cl-gsl) + (:export + #:free-matrix + ))

1 0