From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:44:16 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:44:16 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ffi.lisp Message-ID: <20050404004416.417FE8866C@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv29878 Modified Files: ffi.lisp Log Message: Added macros which allocate, bind, and free foreign structures. Date: Mon Apr 4 02:44:15 2005 Author: edenny Index: cl-gsl/ffi.lisp diff -u cl-gsl/ffi.lisp:1.3 cl-gsl/ffi.lisp:1.4 --- cl-gsl/ffi.lisp:1.3 Tue Mar 15 04:15:20 2005 +++ cl-gsl/ffi.lisp Mon Apr 4 02:44:15 2005 @@ -56,7 +56,8 @@ ;; ---------------------------------------------------------------------- -;; TODO: size_t may not always be unsigned long, could also be unsigned int. +;; TODO: size_t may not always be unsigned long, could also be unsigned int +;; on some systems? (define-foreign-type size-t :unsigned-long) (def-foreign-struct gsl-complex @@ -192,56 +193,76 @@ ;; typedef long double * gsl_complex_packed_array_long_double ; ;; typedef long double * gsl_complex_packed_long_double_ptr ; -;; typedef struct -;; { -;; long double dat[2]; -;; } -;; gsl_complex_long_double; - ;; ---------------------------------------------------------------------- (defun gsl-complex->complex (z-ptr) - ;; TODO: this seems to work with pointers and values -;; (declare (gsl-complex-def z)) + "Copies the value of the foreign object pointed to by Z-PTR to a lisp object +of type (complex (double-float)). Returns the lisp object." (let ((dat-array (uffi:get-slot-value z-ptr '(:array :double) 'cl-gsl::dat))) (complex (uffi:deref-array dat-array :double 0) (uffi:deref-array dat-array :double 1)))) (defun gsl-complex-float->complex (z-ptr) + "Copies the value of the foreign object pointed to by Z-PTR to a lisp object +of type (complex (single-float)). Returns the lisp object." (let ((dat-array (uffi:get-slot-value z-ptr '(:array :float) 'cl-gsl::dat))) (complex (uffi:deref-array dat-array :float 0) (uffi:deref-array dat-array :float 1)))) -;; FIXME: this returns a pointer to a gsl-complex. Is this correct? -;; How do we free it? -;; Replace with a with-complex->gsl-complex macro that cleans up after -;; itself -(defun complex->gsl-complex-ptr (z) - (let* ((z-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (dat-array (uffi:get-slot-value z-ptr '(:array :double) 'cl-gsl::dat))) - (setf (uffi:deref-array dat-array :double 0) (realpart z)) - (setf (uffi:deref-array dat-array :double 1) (imagpart z)) - z-ptr)) - -;; FIXME: see above -(defun complex->gsl-complex-float-ptr (z) - (let* ((z-ptr (uffi:allocate-foreign-object 'gsl-complex-float)) - (dat-array (uffi:get-slot-value z-ptr '(:array :float) 'cl-gsl::dat))) - (setf (uffi:deref-array dat-array :float 0) (realpart z)) - (setf (uffi:deref-array dat-array :float 1) (imagpart z)) - z-ptr)) - - -;; TODO: generalize to all supported types? -(defun lisp-vec->c-array (v) - (declare (vector v)) - (let* ((len (length v)) - (c-ptr (uffi:allocate-foreign-object :double len))) - (dotimes (i len) - (setf (uffi:deref-array c-ptr :double i) (aref v i))) - c-ptr)) -;; TODO: generalize to all supported types? +(defmacro with-complex-double-float->gsl-complex-ptr ((c-ptr complex-val) + &body body) + "Copies the value of COMPLEX-VALUE, of type (complex (double-float)), +to a newly created foreign object of type gsl_complex. C-PTR is a pointer +to the foreign object. Returns the values of BODY and frees the memory +allocated for the foreign object." + (let ((array (gensym))) + `(let* ((,c-ptr (uffi:allocate-foreign-object 'gsl-complex)) + (,array (uffi:get-slot-value ,c-ptr + '(:array :double) + 'cl-gsl::dat))) + (unwind-protect + (progn + (setf (uffi:deref-array ,array :double 0) (realpart ,complex-val)) + (setf (uffi:deref-array ,array :double 1) (imagpart ,complex-val)) + , at body) + (uffi:free-foreign-object ,c-ptr))))) + + +(defmacro with-complex-single-float->gsl-complex-float-ptr ((c-ptr complex-val) + &body body) + "Copies the value of COMPLEX-VALUE, of type (complex (single-float)), +to a newly created foreign object of type gsl_complex_float. C-PTR is a pointer +to the foreign object. Returns the values of BODY and frees the memory +allocated for the foreign object." + (let ((array (gensym))) + `(let* ((,c-ptr (uffi:allocate-foreign-object 'gsl-complex-float)) + (,array (uffi:get-slot-value ,c-ptr + '(:array :float) + 'cl-gsl::dat))) + (unwind-protect + (progn + (setf (uffi:deref-array ,array :float 0) (realpart ,complex-val)) + (setf (uffi:deref-array ,array :float 1) (imagpart ,complex-val)) + , at body) + (uffi:free-foreign-object ,c-ptr))))) + + +(defmacro with-lisp-vec->c-array ((c-ptr lisp-vec) &body body) + (let ((len (gensym)) + (i (gensym))) + `(progn + (let* ((,len (length ,lisp-vec)) + (,c-ptr (uffi:allocate-foreign-object :double ,len))) + (unwind-protect + (progn + (dotimes (,i ,len) + (setf (uffi:deref-array ,c-ptr :double ,i) + (aref ,lisp-vec ,i))) + , at body) + (uffi:free-foreign-object ,c-ptr)))))) + + (defun c-array->lisp-vec (c-ptr len) (let ((lisp-vec (make-array len :element-type 'double-float))) (dotimes (i len) @@ -249,6 +270,9 @@ lisp-vec)) (defun complex-packed-array->lisp-vec (z-ptr len) + "Copies the complex values of a foreign array to a lisp array. Z-PTR is +a pointer the the foreign array of length LEN. Returns a lisp array of +complex elements, also of length LEN." (declare (gsl-complex-packed-def z-ptr)) (let ((lisp-vec (make-array (/ len 2) :element-type 'complex))) (dotimes (i (/ len 2)) From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:45:26 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:45:26 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/package.lisp Message-ID: <20050404004526.164E8886FE@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv30183 Modified Files: package.lisp Log Message: Add additional symbols to package cl-gsl-vector. Date: Mon Apr 4 02:45:25 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.3 cl-gsl/package.lisp:1.4 --- cl-gsl/package.lisp:1.3 Tue Mar 15 04:15:57 2005 +++ cl-gsl/package.lisp Mon Apr 4 02:45:25 2005 @@ -38,10 +38,10 @@ #:def-foreign-struct #:gsl-complex->complex #:gsl-complex-float->complex - #:lisp-vec->c-array + #:with-lisp-vec->c-array #:complex-packed-array->lisp-vec - #:complex->gsl-complex-ptr - #:complex->gsl-complex-float-ptr + #:with-complex-double-float->gsl-complex-ptr + #:with-complex-single-float->gsl-complex-float-ptr #:c-array->lisp-vec #:defconstant-export #:register-constants @@ -69,6 +69,9 @@ #:complex-solve-quadratic #:complex-solve-cubic #:complex-solve + #:dd-init + #:dd-eval + #:dd-taylor )) (defpackage #:cl-gsl-sf @@ -100,6 +103,7 @@ #:free #:make-vector + #:with-vector #:get-element #:set-element #:set-all @@ -112,6 +116,7 @@ #:subvector #:subvector-with-stride #:copy + #:with-vector-copy #:swap #:swap-elements #:reverse-vector From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:46:44 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:46:44 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/poly.lisp Message-ID: <20050404004644.C8E2D886FE@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv30704 Modified Files: poly.lisp Log Message: Replace some functions with macros that clean up after themselves. Plug a leak. Date: Mon Apr 4 02:46:44 2005 Author: edenny Index: cl-gsl/poly.lisp diff -u cl-gsl/poly.lisp:1.2 cl-gsl/poly.lisp:1.3 --- cl-gsl/poly.lisp:1.2 Sun Mar 13 01:48:25 2005 +++ cl-gsl/poly.lisp Mon Apr 4 02:46:42 2005 @@ -26,10 +26,11 @@ :double) (defun poly-eval (coefficients x) - (let ((c-ptr (lisp-vec->c-array coefficients))) - (prog1 - (gsl-poly-eval c-ptr (length coefficients) x) - (uffi:free-foreign-object c-ptr)))) + "Returns the value of the polynomial +c[0] + c[1] X + c[2] X^2 + ... + c[n-1] X^{n-1} +where COEFFICIENTS is a vector of the coefficients of length n." + (with-lisp-vec->c-array (c-ptr coefficients) + (gsl-poly-eval c-ptr (length coefficients) x))) ;; ---------------------------------------------------------------------- @@ -42,19 +43,20 @@ :int) (defun solve-quadratic (a b c) + "Computes the real roots of the quadratic equation A x^2 + B x + C = 0. +Returns three values. The first two values are the real roots of the equation. +The third value is the number of roots (either 2 or 0). +If there are 0 real roots, the first two values are 0.0d0. When there are +2 real roots, their values are returned in ascending order." (declare (double-float a) (double-float b) (double-float c)) - (let ((x0-ptr (uffi:allocate-foreign-object :double)) - (x1-ptr (uffi:allocate-foreign-object :double)) - (num-roots) - (x0) - (x1)) - (declare (double-ptr-def x0-ptr) (double-ptr-def x1-ptr)) - (setq num-roots (gsl-poly-solve-quadratic a b c x0-ptr x1-ptr) - x0 (uffi:deref-pointer x0-ptr :double) - x1 (uffi:deref-pointer x1-ptr :double)) - (uffi:free-foreign-object x0-ptr) - (uffi:free-foreign-object x1-ptr) - (values x0 x1 num-roots))) + (uffi:with-foreign-object (x0-ptr :double) + (uffi:with-foreign-object (x1-ptr :double) + (setf (uffi:deref-pointer x0-ptr :double) 0.0d0) + (setf (uffi:deref-pointer x1-ptr :double) 0.0d0) + (let ((num-roots (gsl-poly-solve-quadratic a b c x0-ptr x1-ptr))) + (values (uffi:deref-pointer x0-ptr :double) + (uffi:deref-pointer x1-ptr :double) + num-roots))))) ;; ---------------------------------------------------------------------- @@ -68,24 +70,24 @@ :int) (defun solve-cubic (a b c) + "Computes the real roots of the cubic equation, x^3 + A x^2 + B x + C = 0 +with a leading coefficient of unity. +Returns four values. The first 3 values are the real roots of the equation. +The fourth value is the number of real roots (either 1 or 3). +If 1 real root is found, the other two roots are 0.0d0. When 3 real +roots are found, they are returned in ascending order." (declare (double-float a) (double-float b) (double-float c)) - (let ((x0-ptr (uffi:allocate-foreign-object :double)) - (x1-ptr (uffi:allocate-foreign-object :double)) - (x2-ptr (uffi:allocate-foreign-object :double)) - (num-roots) - (x0) - (x1) - (x2)) - (declare (double-ptr-def x0-ptr) (double-ptr-def x1-ptr) - (double-ptr-def x2-ptr)) - (setq num-roots (gsl-poly-solve-cubic a b c x0-ptr x1-ptr x2-ptr) - x0 (uffi:deref-pointer x0-ptr :double) - x1 (uffi:deref-pointer x1-ptr :double) - x2 (uffi:deref-pointer x2-ptr :double)) - (uffi:free-foreign-object x0-ptr) - (uffi:free-foreign-object x1-ptr) - (uffi:free-foreign-object x2-ptr) - (values x0 x1 x2 num-roots))) + (uffi:with-foreign-object (x0-ptr :double) + (uffi:with-foreign-object (x1-ptr :double) + (uffi:with-foreign-object (x2-ptr :double) + (setf (uffi:deref-pointer x0-ptr :double) 0.0d0) + (setf (uffi:deref-pointer x1-ptr :double) 0.0d0) + (setf (uffi:deref-pointer x2-ptr :double) 0.0d0) + (let ((num-roots (gsl-poly-solve-cubic a b c x0-ptr x1-ptr x2-ptr))) + (values (uffi:deref-pointer x0-ptr :double) + (uffi:deref-pointer x1-ptr :double) + (uffi:deref-pointer x2-ptr :double) + num-roots)))))) ;; ---------------------------------------------------------------------- @@ -100,18 +102,12 @@ (defun complex-solve-quadratic (a b c) (declare (double-float a) (double-float b) (double-float c)) - (let ((z0-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (z1-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (num-roots) - (z0) - (z1)) - (declare (gsl-complex-ptr-def z0-ptr) (gsl-complex-ptr-def z1-ptr)) - (setq num-roots (gsl-poly-complex-solve-quadratic a b c z0-ptr z1-ptr) - z0 (uffi:deref-pointer z0-ptr 'gsl-complex) - z1 (uffi:deref-pointer z1-ptr 'gsl-complex)) - (uffi:free-foreign-object z0-ptr) - (uffi:free-foreign-object z1-ptr) - (values (gsl-complex->complex z0) (gsl-complex->complex z1) num-roots))) + (uffi:with-foreign-object (z0-ptr 'gsl-complex) + (uffi:with-foreign-object (z1-ptr 'gsl-complex) + (let ((num-roots (gsl-poly-complex-solve-quadratic a b c z0-ptr z1-ptr))) + (values (gsl-complex->complex (uffi:deref-pointer z0-ptr 'gsl-complex)) + (gsl-complex->complex (uffi:deref-pointer z1-ptr 'gsl-complex)) + num-roots))))) ;; ---------------------------------------------------------------------- @@ -126,24 +122,15 @@ (defun complex-solve-cubic (a b c) (declare (double-float a) (double-float b) (double-float c)) - (let ((z0-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (z1-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (z2-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (num-roots) - (z0) - (z1) - (z2)) - (declare (gsl-complex-ptr-def z0-ptr) (gsl-complex-ptr-def z1-ptr) - (gsl-complex-ptr-def z2-ptr)) - (setq num-roots (gsl-poly-complex-solve-cubic a b c z0-ptr z1-ptr z2-ptr) - z0 (uffi:deref-pointer z0-ptr 'gsl-complex) - z1 (uffi:deref-pointer z1-ptr 'gsl-complex) - z2 (uffi:deref-pointer z2-ptr 'gsl-complex)) - (uffi:free-foreign-object z0-ptr) - (uffi:free-foreign-object z1-ptr) - (uffi:free-foreign-object z2-ptr) - (values (gsl-complex->complex z0) (gsl-complex->complex z1) - (gsl-complex->complex z2) num-roots))) + (uffi:with-foreign-object (z0-ptr 'gsl-complex) + (uffi:with-foreign-object (z1-ptr 'gsl-complex) + (uffi:with-foreign-object (z2-ptr 'gsl-complex) + (let ((num-roots (gsl-poly-complex-solve-cubic a b c + z0-ptr z1-ptr z2-ptr))) + (values (gsl-complex->complex (uffi:deref-pointer z0-ptr 'gsl-complex)) + (gsl-complex->complex (uffi:deref-pointer z1-ptr 'gsl-complex)) + (gsl-complex->complex (uffi:deref-pointer z2-ptr 'gsl-complex)) + num-roots)))))) ;; ---------------------------------------------------------------------- @@ -163,16 +150,15 @@ :int) (defun complex-solve (a) - (let* ((a-ptr (lisp-vec->c-array a)) - (len (length a)) - (w (gsl-poly-complex-workspace-alloc len)) - (z-ptr (uffi:allocate-foreign-object :double (* 2 (1- len)))) - (ret-val)) - (setq ret-val (gsl-poly-complex-solve a-ptr len w z-ptr)) - (gsl-poly-complex-workspace-free w) - (multiple-value-prog1 - (values (complex-packed-array->lisp-vec z-ptr (* 2 (1- len))) ret-val) - (uffi:free-foreign-object z-ptr)))) + (with-lisp-vec->c-array (a-ptr a) + (let* ((len (length a)) + (w (gsl-poly-complex-workspace-alloc len)) + (z-ptr (uffi:allocate-foreign-object :double (* 2 (1- len)))) + (ret-val (gsl-poly-complex-solve a-ptr len w z-ptr))) + (gsl-poly-complex-workspace-free w) + (multiple-value-prog1 + (values (complex-packed-array->lisp-vec z-ptr (* 2 (1- len))) ret-val) + (uffi:free-foreign-object z-ptr))))) ;; ---------------------------------------------------------------------- @@ -183,18 +169,20 @@ (size :unsigned-long)) :int) + (defun dd-init (xa ya) - (let* ((xa-ptr (lisp-vec->c-array xa)) - (ya-ptr (lisp-vec->c-array ya)) - (len (length xa)) - (dd-ptr (uffi:allocate-foreign-object :double len)) - (ret-val)) - (setq ret-val (gsl-poly-dd-init dd-ptr xa-ptr ya-ptr len)) - (multiple-value-prog1 - (values (c-array->lisp-vec dd-ptr len) ret-val) - (uffi:free-foreign-object xa-ptr) - (uffi:free-foreign-object ya-ptr) - (uffi:free-foreign-object dd-ptr)))) + "Computes a divided-difference representation of the interpolating polynomial +for the points (xa, ya) stored in the vectors XA and YA of equal length. +Returns two values: the divided differences as a vector of length equal to XA, +and the status, indicating the success of the computation." + (with-lisp-vec->c-array (xa-ptr xa) + (with-lisp-vec->c-array (ya-ptr ya) + (let* ((len (length xa)) + (dd-ptr (uffi:allocate-foreign-object :double len)) + (ret-val (gsl-poly-dd-init dd-ptr xa-ptr ya-ptr len))) + (multiple-value-prog1 + (values (c-array->lisp-vec dd-ptr len) ret-val) + (uffi:free-foreign-object dd-ptr)))))) ;; ---------------------------------------------------------------------- @@ -205,14 +193,13 @@ (x :double)) :double) + (defun dd-eval (dd xa x) - (let ((dd-ptr (lisp-vec->c-array dd)) - (xa-ptr (lisp-vec->c-array xa)) - (len (length dd))) - (prog1 - (gsl-poly-dd-eval dd-ptr xa-ptr len x) - (uffi:free-foreign-object xa-ptr) - (uffi:free-foreign-object dd-ptr)))) + "Returns the value of the polynomial at point X. The vectors DD and XA, +of equal length, store the divided difference representation of the polynomial." + (with-lisp-vec->c-array (dd-ptr dd) + (with-lisp-vec->c-array (xa-ptr xa) + (gsl-poly-dd-eval dd-ptr xa-ptr (length dd) x)))) ;; ---------------------------------------------------------------------- @@ -225,17 +212,19 @@ (w double-ptr)) :int) + (defun dd-taylor (xp dd xa) - (let* ((dd-ptr (lisp-vec->c-array dd)) - (xa-ptr (lisp-vec->c-array xa)) - (len (length dd)) - (w-ptr (uffi:allocate-foreign-object :double len)) - (c-ptr (uffi:allocate-foreign-object :double len)) - (ret-val)) - (setq ret-val (gsl-poly-dd-taylor c-ptr xp dd-ptr xa-ptr len w-ptr)) - (multiple-value-prog1 - (values (c-array->lisp-vec c-ptr len) ret-val) - (uffi:free-foreign-object w-ptr) - (uffi:free-foreign-object xa-ptr) - (uffi:free-foreign-object dd-ptr) - (uffi:free-foreign-object c-ptr)))) + "Converts the divided-difference representation of a polynomial to +a Taylor expansion. The divided-difference representation is supplied in the +vectors DD and XA of equal length. Returns a vector of the Taylor coefficients +of the polynomial expanded about the point XP." + (with-lisp-vec->c-array (dd-ptr dd) + (with-lisp-vec->c-array (xa-ptr xa) + (let* ((len (length dd)) + (w-ptr (uffi:allocate-foreign-object :double len)) + (c-ptr (uffi:allocate-foreign-object :double len)) + (ret-val (gsl-poly-dd-taylor c-ptr xp dd-ptr xa-ptr len w-ptr))) + (multiple-value-prog1 + (values (c-array->lisp-vec c-ptr len) ret-val) + (uffi:free-foreign-object w-ptr) + (uffi:free-foreign-object c-ptr)))))) From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:47:41 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:47:41 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/vector.lisp Message-ID: <20050404004741.19562886FE@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv30732 Modified Files: vector.lisp Log Message: Add macros that automatically free foreign objects. Date: Mon Apr 4 02:47:40 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.4 cl-gsl/vector.lisp:1.5 --- cl-gsl/vector.lisp:1.4 Tue Mar 15 04:17:29 2005 +++ cl-gsl/vector.lisp Mon Apr 4 02:47:39 2005 @@ -345,11 +345,11 @@ ((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))) - (wrap-gsl-vector-complex-float-set (gsl-vec-ptr v) i - (complex->gsl-complex-float-ptr x))) + (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))) - (wrap-gsl-vector-complex-set (gsl-vec-ptr v) i - (complex->gsl-complex-ptr x))) + (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")))) @@ -365,11 +365,11 @@ ((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))) - (wrap-gsl-vector-complex-float-set-all (gsl-vec-ptr v) - (complex->gsl-complex-float-ptr x))) + (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))) - (wrap-gsl-vector-complex-set-all (gsl-vec-ptr v) - (complex->gsl-complex-ptr x))) + (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")))) @@ -439,6 +439,17 @@ v)) +(defmacro with-vector ((vec size &key element-type initial-element + initial-contents) &body body) + `(let ((,vec (make-vector ,size + :element-type (or ,element-type 'double-float) + :initial-element ,initial-element + :initial-contents ,initial-contents))) + (unwind-protect + , at body + (free ,vec)))) + + (defun write-to-binary-file (file-name v) (assert (eq 'gsl-vec (type-of v))) (let ((status)) @@ -608,6 +619,13 @@ (t (error "No matching type"))))) (values v-dest status))) + + +(defmacro with-vector-copy ((vec-dest vec-src) &body body) + `(let ((,vec-dest (copy ,vec-src))) + (unwind-protect + , at body + (free ,vec-dest)))) (defun swap (va vb) From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:48:27 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:48:27 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/doc/Makefile Message-ID: <20050404004827.8F7B6886FE@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/doc In directory common-lisp.net:/tmp/cvs-serv30753 Modified Files: Makefile Log Message: Add another file type to clean dependency. Date: Mon Apr 4 02:48:27 2005 Author: edenny Index: cl-gsl/doc/Makefile diff -u cl-gsl/doc/Makefile:1.2 cl-gsl/doc/Makefile:1.3 --- cl-gsl/doc/Makefile:1.2 Sun Mar 27 05:46:32 2005 +++ cl-gsl/doc/Makefile Mon Apr 4 02:48:26 2005 @@ -3,7 +3,8 @@ #### GNU Makefile clean: - $(RM) *.png *.4ct *.4tc *.aux *.css *.dvi *.html *.idv *.lg *.log *.tmp *.xref *.toc + $(RM) *.png *.4ct *.4tc *.aux *.css *.dvi *.html *.idv *.lg *.log *.tmp *.xref *.toc *.idx + html: htlatex cl-gsl-ref.tex From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:51:19 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:51:19 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/doc/cl-gsl-ref.tex Message-ID: <20050404005119.16C9D886FE@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/doc In directory common-lisp.net:/tmp/cvs-serv30781 Added Files: cl-gsl-ref.tex Log Message: Add math alt macro. It create a html image alt that preserves the original latex. Date: Mon Apr 4 02:51:18 2005 Author: edenny From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:52:06 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:52:06 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/doc/math.tex Message-ID: <20050404005206.9785F886FE@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/doc In directory common-lisp.net:/tmp/cvs-serv30800 Modified Files: math.tex Log Message: Use \mathalt macro for equations. Date: Mon Apr 4 02:52:04 2005 Author: edenny Index: cl-gsl/doc/math.tex diff -u cl-gsl/doc/math.tex:1.2 cl-gsl/doc/math.tex:1.3 --- cl-gsl/doc/math.tex:1.2 Sun Mar 27 05:47:52 2005 +++ cl-gsl/doc/math.tex Mon Apr 4 02:52:03 2005 @@ -6,38 +6,39 @@ \begin{description} -\item [\const{+e+}] The base of exponentials, \(e\) +\item [\const{+e+}] The base of exponentials, \mathalt{$e$} -\item [\const{+log2e+}] The base-2 logarithm of e, \(\log_2(e)\) +\item [\const{+log2e+}] The base-2 logarithm of e, \mathalt{$\log_2(e)$} -\item [\const{+log10e+}] The base-10 logarithm of e, \(\log_{10}(e)\) +\item [\const{+log10e+}] The base-10 logarithm of e, \mathalt{$\log_{10}(e)$} -\item [\const{+sqrt2+}] The square root of two, \(\sqrt 2\) +\item [\const{+sqrt2+}] The square root of two, \mathalt{$\sqrt 2$} -\item [\const{+sqrt1/2+}] The square root of one-half, \(\sqrt{1/2}\) +\item [\const{+sqrt1/2+}] The square root of one-half,\mathalt{$\sqrt{1/2}$} -\item [\const{+sqrt3+}] The square root of three, \(\sqrt 3\) +\item [\const{+sqrt3+}] The square root of three, \mathalt{$\sqrt 3$} -\item [\const{+pi+}] The constant pi, \(\pi\) +\item [\const{+pi+}] The constant pi, \mathalt{$\pi$} -\item [\const{+pi/2+}] Pi divided by two, \(\pi/2\) +\item [\const{+pi/2+}] Pi divided by two, \mathalt{$\pi/2$} -\item [\const{+pi/4+}] Pi divided by four, \(\pi/4\) +\item [\const{+pi/4+}] Pi divided by four, \mathalt{$\pi/4$} -\item [\const{+sqrtpi+}] The square root of pi, \(\sqrt\pi\) +\item [\const{+sqrtpi+}] The square root of pi, \mathalt{$\sqrt\pi$} -\item [\const{+2/sqrtpi+}] Two divided by the square root of pi, \(2/\sqrt\pi\) +\item [\const{+2/sqrtpi+}] Two divided by the square root of pi, +\mathalt{$2/\sqrt\pi$} -\item [\const{+1/pi+}] The reciprocal of pi, \(1/\pi\) +\item [\const{+1/pi+}] The reciprocal of pi, \mathalt{$1/\pi$} -\item [\const{+2/pi+}] Twice the reciprocal of pi, \(2/\pi\) +\item [\const{+2/pi+}] Twice the reciprocal of pi, \mathalt{$2/\pi$} -\item [\const{+ln10+}] The natural logarithm of ten, \(\ln(10)\) +\item [\const{+ln10+}] The natural logarithm of ten, \mathalt{$\ln(10)$} -\item [\const{+ln2+}] The natural logarithm of two, \(\ln(2)\) +\item [\const{+ln2+}] The natural logarithm of two, \mathalt{$\ln(2)$} -\item [\const{+lnpi+}] The natural logarithm of pi, \(\ln(\pi)\) +\item [\const{+lnpi+}] The natural logarithm of pi, \mathalt{$\ln(\pi)$} -\item [\const{+euler+}] Euler's constant, \(\gamma\) +\item [\const{+euler+}] Euler's constant, \mathalt{$\gamma$} \end{description} From cl-gsl-cvs at common-lisp.net Mon Apr 4 00:53:29 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 02:53:29 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050404005329.17C6D886FE@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv30822 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 4 02:53:28 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.10 cl-gsl/ChangeLog:1.11 --- cl-gsl/ChangeLog:1.10 Sun Mar 27 05:49:46 2005 +++ cl-gsl/ChangeLog Mon Apr 4 02:53:28 2005 @@ -1,3 +1,28 @@ +2005-04-04 Edgar Denny + + * doc/math.tex: Use \mathalt macro for equations. + + * doc/cl-gsl-ref.tex: + Add \mathalt macro. It create a html image alt that preserves the + original latex. + + * doc/Makefile: Add another file type to clean dependency. + + * vector.lisp: Add macros that automatically free foreign objects. + + * poly.lisp: Replace some functions with macros that clean up after + themselves. Plug a leak. + + * package.lisp: Add additional symbols to package cl-gsl-vector. + + * ffi.lisp: + Added macros which allocate, bind, and free foreign structures. + +2005-03-29 Edgar Denny + + * doc/index.html, doc/introduction.html, doc/poly.html, doc/sf.html: + Remove html files. + 2005-03-27 Edgar Denny * sf.tex, poly.tex, math.tex, constants.tex: tex4ht fixes. From cl-gsl-cvs at common-lisp.net Mon Apr 4 02:02:36 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 4 Apr 2005 04:02:36 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050404020236.6E5DC88704@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv2630 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 4 04:02:35 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.11 cl-gsl/ChangeLog:1.12 --- cl-gsl/ChangeLog:1.11 Mon Apr 4 02:53:28 2005 +++ cl-gsl/ChangeLog Mon Apr 4 04:02:35 2005 @@ -3,7 +3,7 @@ * doc/math.tex: Use \mathalt macro for equations. * doc/cl-gsl-ref.tex: - Add \mathalt macro. It create a html image alt that preserves the + Add \mathalt macro. It creates a html image alt that preserves the original latex. * doc/Makefile: Add another file type to clean dependency. @@ -18,7 +18,7 @@ * ffi.lisp: Added macros which allocate, bind, and free foreign structures. -2005-03-29 Edgar Denny +2005-03-29 Edgar Denny * doc/index.html, doc/introduction.html, doc/poly.html, doc/sf.html: Remove html files. From cl-gsl-cvs at common-lisp.net Thu Apr 7 02:36:21 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 7 Apr 2005 04:36:21 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/package.lisp Message-ID: <20050407023621.5669C18C6CB@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv2156 Modified Files: package.lisp Log Message: Add additional symbols to vector package. Date: Thu Apr 7 04:36:20 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.4 cl-gsl/package.lisp:1.5 --- cl-gsl/package.lisp:1.4 Mon Apr 4 02:45:25 2005 +++ cl-gsl/package.lisp Thu Apr 7 04:36:20 2005 @@ -133,4 +133,5 @@ #:min-max-indicies #:min-max-values #:isnull + #:gsl-vector->lisp-vector )) From cl-gsl-cvs at common-lisp.net Thu Apr 7 02:37:14 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 7 Apr 2005 04:37:14 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/vector.lisp Message-ID: <20050407023714.DC7B618C6CB@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv2175 Modified Files: vector.lisp Log Message: Fixes as a result of unit tests. Date: Thu Apr 7 04:37:14 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.5 cl-gsl/vector.lisp:1.6 --- cl-gsl/vector.lisp:1.5 Mon Apr 4 02:47:39 2005 +++ cl-gsl/vector.lisp Thu Apr 7 04:37:13 2005 @@ -332,6 +332,7 @@ (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))) @@ -351,7 +352,8 @@ (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")))) + (error "No matching type"))) + v) (defun set-all (v x) @@ -371,7 +373,8 @@ (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")))) + (error "No matching type"))) + v) (defun set-zero (v) @@ -388,7 +391,8 @@ ((equal (gsl-vec-element-type v) '(complex (double-float))) (gsl-vector-complex-set-zero (gsl-vec-ptr v))) (t - (error "No matching type")))) + (error "No matching type"))) + v) (defun set-basis (v i) @@ -407,11 +411,57 @@ ((equal (gsl-vec-element-type v) '(complex (double-float))) (gsl-vector-complex-set-basis (gsl-vec-ptr v) i)) (t - (error "No matching type")))) + (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))) (defun make-vector (size &key (element-type 'double-float) initial-element - initial-contents) + initial-contents from-file from-binary-file) (assert (typep size 'integer)) (assert (find element-type '(integer single-float double-float (complex (single-float)) @@ -419,8 +469,8 @@ (let ((v (make-gsl-vec :size size :element-type element-type))) (setf (gsl-vec-ptr v) (alloc v)) (cond - ((and initial-element initial-contents) - (error "cannot define both initial-element and initial-contents keys")) + ((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)) (initial-contents @@ -435,18 +485,25 @@ ((= i size)) (gsl-vector:set-element v i (aref initial-contents i)))) (t - (error "initial-contents must be either a list or a vector."))))) + (error "initial-contents must be either a list or a vector.")))) + (from-file + (read-from-file v from-file size)) + (from-binary-file + (read-from-binary-file v from-binary-file size))) v)) -(defmacro with-vector ((vec size &key element-type initial-element - initial-contents) &body body) +(defmacro with-vector + ((vec size &key element-type initial-element initial-contents from-file + from-binary-file) &body body) `(let ((,vec (make-vector ,size :element-type (or ,element-type 'double-float) :initial-element ,initial-element - :initial-contents ,initial-contents))) + :initial-contents ,initial-contents + :from-file ,from-file + :from-binary-file ,from-binary-file))) (unwind-protect - , at body + (progn , at body) (free ,vec)))) @@ -495,49 +552,6 @@ status)) -(defun read-from-binary-file (file-name size element-type) - (let ((v (make-vector size :element-type element-type)) - (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 (file-name size element-type) - (let ((v (make-vector size :element-type element-type)) - (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))) - - (defun subvector (v offset n) (assert (eq 'gsl-vec (type-of v))) (assert (typep offset 'integer)) @@ -891,6 +905,13 @@ (gsl-vector-complex-isnull (gsl-vec-ptr v))) (t (error "No matching type"))))) + + +(defun gsl-vector->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) + (setf (aref a i) (get-element v i))))) ;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v) ;; Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex *v) From cl-gsl-cvs at common-lisp.net Thu Apr 7 02:37:55 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 7 Apr 2005 04:37:55 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-vector.lisp Message-ID: <20050407023755.D577A18C6C5@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv2190 Modified Files: test-vector.lisp Log Message: Added several new unit tests. Date: Thu Apr 7 04:37:55 2005 Author: edenny Index: cl-gsl/test/test-vector.lisp diff -u cl-gsl/test/test-vector.lisp:1.1 cl-gsl/test/test-vector.lisp:1.2 --- cl-gsl/test/test-vector.lisp:1.1 Tue Mar 15 04:21:49 2005 +++ cl-gsl/test/test-vector.lisp Thu Apr 7 04:37:55 2005 @@ -25,41 +25,51 @@ :test-fn #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type 'double-float))) - (and (= (gsl-vector:gsl-vec-size v) 5) - (eq (gsl-vector:gsl-vec-element-type v) 'double-float))))) + (prog1 + (and (= (gsl-vector:gsl-vec-size v) 5) + (eq (gsl-vector:gsl-vec-element-type v) 'double-float)) + (gsl-vector:free v))))) (deftest "make-vector-single-float" :category +vector+ :test-fn #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type 'single-float))) - (and (= (gsl-vector:gsl-vec-size v) 5) - (eq (gsl-vector:gsl-vec-element-type v) 'single-float))))) + (prog1 + (and (= (gsl-vector:gsl-vec-size v) 5) + (eq (gsl-vector:gsl-vec-element-type v) 'single-float)) + (gsl-vector:free v))))) (deftest "make-vector-integer" :category +vector+ :test-fn #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type 'integer))) - (and (= (gsl-vector:gsl-vec-size v) 5) - (eq (gsl-vector:gsl-vec-element-type v) 'integer))))) + (prog1 + (and (= (gsl-vector:gsl-vec-size v) 5) + (eq (gsl-vector:gsl-vec-element-type v) 'integer)) + (gsl-vector:free v))))) (deftest "make-vector-complex-double-float" :category +vector+ :test-fn #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type '(complex (double-float))))) - (and (= (gsl-vector:gsl-vec-size v) 5) - (equal (gsl-vector:gsl-vec-element-type v) - '(complex (double-float))))))) + (prog1 + (and (= (gsl-vector:gsl-vec-size v) 5) + (equal (gsl-vector:gsl-vec-element-type v) + '(complex (double-float)))) + (gsl-vector:free v))))) (deftest "make-vector-complex-single-float" :category +vector+ :test-fn #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type '(complex (single-float))))) - (and (= (gsl-vector:gsl-vec-size v) 5) - (equal (gsl-vector:gsl-vec-element-type v) - '(complex (single-float))))))) + (prog1 + (and (= (gsl-vector:gsl-vec-size v) 5) + (equal (gsl-vector:gsl-vec-element-type v) + '(complex (single-float)))) + (gsl-vector:free v))))) ;; ---------------------------------------------------------------------- @@ -72,7 +82,9 @@ (ret t)) (dotimes (i 5 ret) (unless (= (gsl-vector:get-element v i) 1.0d0) - (setq ret nil)))))) + (setq ret nil))) + (gsl-vector:free v) + ret))) (deftest "make-vector-single-float-initial-element" :category +vector+ @@ -84,7 +96,9 @@ (ret t)) (dotimes (i 5 ret) (unless (= (gsl-vector:get-element v i) 1.0) - (setq ret nil)))))) + (setq ret nil))) + (gsl-vector:free v) + ret))) (deftest "make-vector-integer-initial-element" :category +vector+ @@ -96,7 +110,9 @@ (ret t)) (dotimes (i 5 ret) (unless (= (gsl-vector:get-element v i) 1) - (setq ret nil)))))) + (setq ret nil))) + (gsl-vector:free v) + ret))) (deftest "make-vector-complex-double-float-initial-element" :category +vector+ :test-fn @@ -109,7 +125,9 @@ (ret t)) (dotimes (i 5 ret) (unless (= (gsl-vector:get-element v i) (complex 1.0d0 1.0d0)) - (setq ret nil)))))) + (setq ret nil))) + (gsl-vector:free v) + ret))) (deftest "make-vector-complex-single-float-initial-element" :category +vector+ :test-fn @@ -121,4 +139,628 @@ (ret t)) (dotimes (i 5 ret) (unless (= (gsl-vector:get-element v i) (complex 1.0 1.0)) - (setq ret nil)))))) + (setq ret nil))) + (gsl-vector:free v) + ret))) + +;; ---------------------------------------------------------------------- + +(deftest "make-vector-double-float-initial-contents" :category +vector+ + :test-fn + #'(lambda () + (let ((v (gsl-vector: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)) + (setq ret nil))) + (gsl-vector:free v) + ret))) + + +(deftest "make-vector-single-float-initial-contents" :category +vector+ + :test-fn + #'(lambda () + (let ((v (gsl-vector: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)) + (setq ret nil))) + (gsl-vector:free v) + ret))) + + +(deftest "make-vector-integer-initial-contents" :category +vector+ + :test-fn + #'(lambda () + (let ((v (gsl-vector: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)) + (setq ret nil))) + (gsl-vector:free v) + ret))) + +(deftest "make-vector-complex-double-float-initial-contents" :category +vector+ + :test-fn + #'(lambda () + (let ((v (gsl-vector:make-vector + 5 + :element-type '(complex (double-float)) + :initial-contents + (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)))) + (ret t) + (val (complex 0.0d0 0.0d0))) + (dotimes (i 5 ret) + (unless (= (gsl-vector:get-element v i) + (incf val (complex 1.0d0 1.0d0))) + (setq ret nil))) + (gsl-vector:free v) + ret))) + +(deftest "make-vector-complex-single-float-initial-contents" :category +vector+ + :test-fn + #'(lambda () + (let ((v (gsl-vector:make-vector + 5 + :element-type '(complex (single-float)) + :initial-contents + (list (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)))) + (ret t) + (val (complex 0.0 0.0))) + (dotimes (i 5 ret) + (unless (= (gsl-vector:get-element v i) + (decf val (complex 1.0 1.0))) + (setq ret nil))) + (gsl-vector:free v) + ret))) + +;; ---------------------------------------------------------------------- + +(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) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector:get-element v i) 5) + (setq ret nil))))))) + +(deftest "set-all-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (gsl-vector:with-vector + (v 5 :element-type '(complex (double-float))) + (gsl-vector:set-all v (complex 5.0d0 4.0d0)) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector: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 + (v 5 :element-type '(complex (single-float))) + (gsl-vector: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)) + (setq ret nil))))))) + +;; ---------------------------------------------------------------------- + +(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) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector:get-element v i) 0) + (setq ret nil))))))) + +(deftest "set-zero-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (gsl-vector:with-vector + (v 5 :element-type '(complex (double-float))) + (gsl-vector:set-all v (complex 5.0d0 4.0d0)) + (gsl-vector:set-zero v) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector: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 + (v 5 :element-type '(complex (single-float))) + (gsl-vector:set-all v (complex 5.0 4.0)) + (gsl-vector:set-zero v) + (let ((ret t)) + (dotimes (i 5 ret) + (unless (= (gsl-vector:get-element v i) (complex 0.0 0.0)) + (setq ret nil))))))) + +;; ---------------------------------------------------------------------- + +(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) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 3) + (unless (= (gsl-vector:get-element v i) 1.0d0) + (setq ret nil)) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 2) + (unless (= (gsl-vector:get-element v i) 1.0) + (setq ret nil)) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 1) + (unless (= (gsl-vector:get-element v i) 1) + (setq ret nil)) + (unless (= (gsl-vector:get-element v i) 0) + (setq ret nil)))))))) + +(deftest "set-basis-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (gsl-vector:with-vector + (v 5 :element-type '(complex (double-float))) + (gsl-vector:set-basis v 4) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 4) + (unless (= (gsl-vector:get-element v i) + (complex 1.0d0 0.0d0)) + (setq ret nil)) + (unless (= (gsl-vector: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 + (v 5 :element-type '(complex (single-float))) + (gsl-vector:set-basis v 0) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 0) + (unless (= (gsl-vector:get-element v i) + (complex 1.0 0.0)) + (setq ret nil)) + (unless (= (gsl-vector:get-element v i) + (complex 0.0 0.0)) + (setq ret nil)))))))) + + +;; ---------------------------------------------------------------------- + +(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) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 3) + (unless (= (gsl-vector:get-element v i) 6.0d0) + (setq ret nil)) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 2) + (unless (= (gsl-vector:get-element v i) 6.0) + (setq ret nil)) + (unless (= (gsl-vector: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) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 1) + (unless (= (gsl-vector:get-element v i) 6) + (setq ret nil)) + (unless (= (gsl-vector:get-element v i) 0) + (setq ret nil)))))))) + +(deftest "set-element-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (gsl-vector: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)) + (let ((ret t)) + (dotimes (i 5 ret) + (if (= i 4) + (unless (= (gsl-vector:get-element v i) + (complex 6.0d0 7.0d0)) + (setq ret nil)) + (unless (= (gsl-vector: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 + (v 5 :element-type '(complex (single-float))) + (gsl-vector:set-zero v) + (gsl-vector: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) + (complex 6.0 7.0)) + (setq ret nil)) + (unless (= (gsl-vector:get-element v i) + (complex 0.0 0.0)) + (setq ret nil)))))))) + +;; ---------------------------------------------------------------------- + +(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)))) + + +(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))))) + + +(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)))) + +(deftest "isnull-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (gsl-vector:with-vector + (v 5 :element-type '(complex (double-float))) + (gsl-vector:set-basis v 1) + (not (gsl-vector:isnull v))))) + +(deftest "isnull-complex-single-float" :category +vector+ + :test-fn + #'(lambda () + (gsl-vector:with-vector + (v 5 :element-type '(complex (single-float))) + (gsl-vector:set-zero v) + (gsl-vector:isnull v)))) + +;; ---------------------------------------------------------------------- + +(deftest "reverse-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))) + (gsl-vector:with-vector + (v 5 :element-type 'double-float :initial-contents vec) + (equalp (reverse vec) + (gsl-vector:gsl-vector->lisp-vector + (gsl-vector: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 + (v 5 :element-type 'single-float :initial-contents vec) + (equalp (reverse vec) + (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:reverse-vector v))))))) + +(deftest "reverse-integer" :category +vector+ + :test-fn + #'(lambda () + (let ((vec (vector 1 2 3 4 5))) + (gsl-vector:with-vector + (v 5 :element-type 'integer :initial-contents vec) + (equalp (reverse vec) + (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:reverse-vector v))))))) + + +(deftest "reverse-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (v 5 :element-type '(complex (double-float)) + :initial-contents vec) + (equalp (reverse vec) + (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:reverse-vector v))))))) + + +(deftest "reverse-complex-single-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (v 5 :element-type '(complex (single-float)) + :initial-contents vec) + (equalp (reverse vec) + (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:reverse-vector v))))))) + +;; ---------------------------------------------------------------------- + +(deftest "read-write-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))) + (gsl-vector:with-vector + (v1 5 :element-type 'double-float :initial-contents vec) + (gsl-vector:write-to-file "/tmp/test.txt" v1) + (gsl-vector:with-vector + (v2 5 :element-type 'double-float + :from-file "/tmp/test.txt") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->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 + (v1 5 :element-type 'single-float :initial-contents vec) + (gsl-vector:write-to-file "/tmp/test.txt" v1) + (gsl-vector:with-vector + (v2 5 :element-type 'single-float + :from-file "/tmp/test.txt") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->lisp-vector v2)))))))) + +(deftest "read-write-integer" :category +vector+ + :test-fn + #'(lambda () + (let ((vec (vector 1 2 3 4 5))) + (gsl-vector:with-vector + (v1 5 :element-type 'integer :initial-contents vec) + (gsl-vector:write-to-file "/tmp/test.txt" v1) + (gsl-vector:with-vector + (v2 5 :element-type 'integer :from-file "/tmp/test.txt") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->lisp-vector v2)))))))) + +(deftest "read-write-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (v1 5 :element-type '(complex (double-float)) + :initial-contents vec) + (gsl-vector:write-to-file "/tmp/test.txt" v1) + (gsl-vector:with-vector + (v2 5 :element-type '(complex (double-float)) + :from-file "/tmp/test.txt") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->lisp-vector v2)))))))) + +(deftest "read-write-complex-single-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (v1 5 :element-type '(complex (single-float)) + :initial-contents vec) + (gsl-vector:write-to-file "/tmp/test.txt" v1) + (gsl-vector:with-vector + (v2 5 :element-type '(complex (single-float)) + :from-file "/tmp/test.txt") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->lisp-vector v2)))))))) + + +;; ---------------------------------------------------------------------- + +(deftest "read-write-binary-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec (vector 1.0000000000001d0 2.0d0 3.0d0 4.0d0 5.0d0))) + (gsl-vector: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 + :from-binary-file "/tmp/test.bin") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->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 + (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 + :from-binary-file "/tmp/test.bin") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->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 + (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 + :from-binary-file "/tmp/test.bin") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->lisp-vector v2)))))))) + +(deftest "read-write-binary-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (v1 5 :element-type '(complex (double-float)) + :initial-contents vec) + (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) + (gsl-vector:with-vector + (v2 5 :element-type '(complex (double-float)) + :from-binary-file "/tmp/test.bin") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->lisp-vector v2)))))))) + +(deftest "read-write-binary-complex-single-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (v1 5 :element-type '(complex (single-float)) + :initial-contents vec) + (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) + (gsl-vector:with-vector + (v2 5 :element-type '(complex (single-float)) + :from-binary-file "/tmp/test.bin") + (and (equalp vec + (gsl-vector:gsl-vector->lisp-vector v1)) + (equalp vec + (gsl-vector:gsl-vector->lisp-vector v2)))))))) From cl-gsl-cvs at common-lisp.net Thu Apr 7 02:40:39 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 7 Apr 2005 04:40:39 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050407024039.0D66718C6C5@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv2217 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 7 04:40:39 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.12 cl-gsl/ChangeLog:1.13 --- cl-gsl/ChangeLog:1.12 Mon Apr 4 04:02:35 2005 +++ cl-gsl/ChangeLog Thu Apr 7 04:40:39 2005 @@ -1,3 +1,11 @@ +2005-04-07 Edgar Denny + + * test/test-vector.lisp: Added several new unit tests. + + * vector.lisp: Fixes due to unit tests. + + * package.lisp: Add new symbols to vector package. + 2005-04-04 Edgar Denny * doc/math.tex: Use \mathalt macro for equations. @@ -18,7 +26,7 @@ * ffi.lisp: Added macros which allocate, bind, and free foreign structures. -2005-03-29 Edgar Denny +2005-03-29 Edgar Denny * doc/index.html, doc/introduction.html, doc/poly.html, doc/sf.html: Remove html files. From cl-gsl-cvs at common-lisp.net Sun Apr 10 02:29:22 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 10 Apr 2005 04:29:22 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/package.lisp Message-ID: <20050410022922.1BCB118C6F8@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv26800 Modified Files: package.lisp Log Message: Minor modifications to exported symbol in gsl-vector package. Date: Sun Apr 10 04:29:21 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.5 cl-gsl/package.lisp:1.6 --- cl-gsl/package.lisp:1.5 Thu Apr 7 04:36:20 2005 +++ cl-gsl/package.lisp Sun Apr 10 04:29:21 2005 @@ -133,5 +133,5 @@ #:min-max-indicies #:min-max-values #:isnull - #:gsl-vector->lisp-vector + #:gsl->lisp-vector )) From cl-gsl-cvs at common-lisp.net Sun Apr 10 02:31:07 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 10 Apr 2005 04:31:07 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/vector.lisp Message-ID: <20050410023107.E2AE918C6F8@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv27234 Modified Files: vector.lisp Log Message: Fix scale and add-constant functions. Only subvector and subvector-with-stride functions now have problems. Date: Sun Apr 10 04:31:06 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.6 cl-gsl/vector.lisp:1.7 --- cl-gsl/vector.lisp:1.6 Thu Apr 7 04:37:13 2005 +++ cl-gsl/vector.lisp Sun Apr 10 04:31:06 2005 @@ -139,7 +139,8 @@ (equal typ '(complex (single-float)))) `(defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") ((vec ,type-ptr) - (x ,type-val)) + ;; seems odd that this is :double for all types + (x :double)) :int)) ,(unless (or (equal typ '(complex (double-float))) @@ -147,7 +148,8 @@ `(defun-foreign ,(concatenate 'string "gsl_" type-string "_add_constant") ((vec ,type-ptr) - (x ,type-val)) + ;; and again, :double for all types + (x :double)) :int)) ,(unless (or (equal typ '(complex (double-float))) @@ -217,14 +219,14 @@ (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_subvector") - ((v gsl-vector-ptr) + ((v ,type-ptr) (offset size-t) (n size-t)) ,type-ptr) (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_subvector_with_stride") - ((v gsl-vector-ptr) + ((v ,type-ptr) (offset size-t) (stride size-t) (n size-t)) @@ -784,9 +786,10 @@ (let ((status (cond ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-scale (gsl-vec-ptr v) x)) + ;; 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) x)) + (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 @@ -800,9 +803,11 @@ (let ((status (cond ((eq (gsl-vec-element-type v) 'integer) - (gsl-vector-int-add-constant (gsl-vec-ptr v) x)) + (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) x)) + (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 @@ -907,7 +912,7 @@ (error "No matching type"))))) -(defun gsl-vector->lisp-vector (v) +(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) From cl-gsl-cvs at common-lisp.net Sun Apr 10 02:32:25 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 10 Apr 2005 04:32:25 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-vector.lisp Message-ID: <20050410023225.9B4EF18C6CB@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv27622 Modified Files: test-vector.lisp Log Message: Add several more test. Almost complete except for subvector and subvector-with-stride tests - which don't work yet. Date: Sun Apr 10 04:32:24 2005 Author: edenny Index: cl-gsl/test/test-vector.lisp diff -u cl-gsl/test/test-vector.lisp:1.2 cl-gsl/test/test-vector.lisp:1.3 --- cl-gsl/test/test-vector.lisp:1.2 Thu Apr 7 04:37:55 2005 +++ cl-gsl/test/test-vector.lisp Sun Apr 10 04:32:24 2005 @@ -49,7 +49,7 @@ (eq (gsl-vector:gsl-vec-element-type v) 'integer)) (gsl-vector:free v))))) -(deftest "make-vector-complex-double-float" :category +vector+ +v(deftest "make-vector-complex-double-float" :category +vector+ :test-fn #'(lambda () (let ((v (gsl-vector:make-vector 5 :element-type @@ -550,7 +550,7 @@ (gsl-vector:with-vector (v 5 :element-type 'double-float :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:gsl->lisp-vector (gsl-vector:reverse-vector v))))))) (deftest "reverse-single-float" :category +vector+ @@ -560,7 +560,7 @@ (gsl-vector:with-vector (v 5 :element-type 'single-float :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:gsl->lisp-vector (gsl-vector:reverse-vector v))))))) (deftest "reverse-integer" :category +vector+ @@ -570,7 +570,7 @@ (gsl-vector:with-vector (v 5 :element-type 'integer :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:gsl->lisp-vector (gsl-vector:reverse-vector v))))))) @@ -584,7 +584,7 @@ (v 5 :element-type '(complex (double-float)) :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:gsl->lisp-vector (gsl-vector:reverse-vector v))))))) @@ -598,7 +598,7 @@ (v 5 :element-type '(complex (single-float)) :initial-contents vec) (equalp (reverse vec) - (gsl-vector:gsl-vector->lisp-vector + (gsl-vector:gsl->lisp-vector (gsl-vector:reverse-vector v))))))) ;; ---------------------------------------------------------------------- @@ -613,10 +613,8 @@ (gsl-vector:with-vector (v2 5 :element-type 'double-float :from-file "/tmp/test.txt") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-single-float" :category +vector+ :test-fn @@ -628,10 +626,8 @@ (gsl-vector:with-vector (v2 5 :element-type 'single-float :from-file "/tmp/test.txt") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-integer" :category +vector+ :test-fn @@ -642,10 +638,8 @@ (gsl-vector:write-to-file "/tmp/test.txt" v1) (gsl-vector:with-vector (v2 5 :element-type 'integer :from-file "/tmp/test.txt") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-complex-double-float" :category +vector+ :test-fn @@ -660,10 +654,8 @@ (gsl-vector:with-vector (v2 5 :element-type '(complex (double-float)) :from-file "/tmp/test.txt") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-complex-single-float" :category +vector+ :test-fn @@ -678,10 +670,8 @@ (gsl-vector:with-vector (v2 5 :element-type '(complex (single-float)) :from-file "/tmp/test.txt") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) ;; ---------------------------------------------------------------------- @@ -695,10 +685,8 @@ (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) (gsl-vector:with-vector (v2 5 :element-type 'double-float :from-binary-file "/tmp/test.bin") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-single-float" :category +vector+ :test-fn @@ -709,10 +697,8 @@ (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) (gsl-vector:with-vector (v2 5 :element-type 'single-float :from-binary-file "/tmp/test.bin") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-integer" :category +vector+ @@ -724,10 +710,8 @@ (gsl-vector:write-to-binary-file "/tmp/test.bin" v1) (gsl-vector:with-vector (v2 5 :element-type 'integer :from-binary-file "/tmp/test.bin") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-complex-double-float" :category +vector+ :test-fn @@ -742,10 +726,8 @@ (gsl-vector:with-vector (v2 5 :element-type '(complex (double-float)) :from-binary-file "/tmp/test.bin") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) (deftest "read-write-binary-complex-single-float" :category +vector+ :test-fn @@ -760,7 +742,599 @@ (gsl-vector:with-vector (v2 5 :element-type '(complex (single-float)) :from-binary-file "/tmp/test.bin") - (and (equalp vec - (gsl-vector:gsl-vector->lisp-vector v1)) - (equalp vec - (gsl-vector:gsl-vector->lisp-vector v2)))))))) + (and (equalp vec (gsl-vector:gsl->lisp-vector v1)) + (equalp vec (gsl-vector:gsl->lisp-vector v2)))))))) + +;; ---------------------------------------------------------------------- + +(deftest "copy-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) + (v2) + (res)) + (gsl-vector: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)) + 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 + (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)))))))) + +(deftest "copy-integer" :category +vector+ + :test-fn + #'(lambda () + (let ((vec (vector 1 2 3 4 5))) + (gsl-vector: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)))))))) + +(deftest "copy-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (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)))))))) + +(deftest "copy-complex-single-float" :category +vector+ + :test-fn + #'(lambda () + (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 + (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)))))))) + + +;; ---------------------------------------------------------------------- + +(deftest "swap-double-float" :category +vector+ + :test-fn + #'(lambda () + (let* ((vec-1 (vector 1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)) + (vec-2 (reverse vec-1))) + (gsl-vector:with-vector + (v1 5 :element-type 'double-float :initial-contents vec-1) + (gsl-vector: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)))))))) + +(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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (gsl-vector: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)))))))) + +(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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (gsl-vector: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)))))))) + +(deftest "swap-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (let* ((vec-1 (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))) + (vec-2 (reverse vec-1))) + (gsl-vector:with-vector + (v1 5 :element-type '(complex (double-float)) + :initial-contents vec-1) + (gsl-vector: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)))))))) + +(deftest "swap-complex-single-float" :category +vector+ + :test-fn + #'(lambda () + (let* ((vec-1 (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))) + (vec-2 (reverse vec-1))) + (gsl-vector:with-vector + (v1 5 :element-type '(complex (single-float)) + :initial-contents vec-1) + (gsl-vector: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)))))))) + +;; ---------------------------------------------------------------------- + +(deftest "swap-elements-double-float" :category +vector+ + :test-fn + #'(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 + (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)))))) + +(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 + (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)))))) + +(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 + (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)))))) + +(deftest "swap-elements-complex-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec-1 (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))) + (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 + (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)))))) + +(deftest "swap-elements-complex-single-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec-1 (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))) + (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 + (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))))))) + +;; ---------------------------------------------------------------------- + +(deftest "add-double-float" :category +vector+ + :test-fn + #'(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 + (v1 5 :element-type 'double-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (gsl-vector: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))))))) + + +;; ---------------------------------------------------------------------- + +(deftest "sub-double-float" :category +vector+ + :test-fn + #'(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 + (v1 5 :element-type 'double-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (gsl-vector: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))))))) + +;; ---------------------------------------------------------------------- + +(deftest "mul-double-float" :category +vector+ + :test-fn + #'(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 + (v1 5 :element-type 'double-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (gsl-vector: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))))))) + +;; ---------------------------------------------------------------------- + +(deftest "div-double-float" :category +vector+ + :test-fn + #'(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 + (v1 5 :element-type 'double-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (gsl-vector: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))))))) + +(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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (gsl-vector: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))))))) + + +;; ---------------------------------------------------------------------- + +(deftest "scale-double-float" :category +vector+ + :test-fn + #'(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 + (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)))))) + +(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 + (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)))))) + +(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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (gsl-vector:scale v1 10) + (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + + +;; ---------------------------------------------------------------------- + +(deftest "add-constant-double-float" :category +vector+ + :test-fn + #'(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 + (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)))))) + +(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 + (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)))))) + +(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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (gsl-vector:add-constant v1 10) + (equalp vec-2 (gsl-vector:gsl->lisp-vector v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "max-value-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) + (max-val 5.0d0)) + (gsl-vector:with-vector + (v1 5 :element-type 'double-float :initial-contents vec-1) + (= max-val (gsl-vector: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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (= max-val (gsl-vector: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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (= max-val (gsl-vector:max-value v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "min-value-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) + (min-val 1.0d0)) + (gsl-vector:with-vector + (v1 5 :element-type 'double-float :initial-contents vec-1) + (= min-val (gsl-vector: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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (= min-val (gsl-vector: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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (= min-val (gsl-vector:min-value v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "max-index-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) + (max-idx 1)) + (gsl-vector:with-vector + (v1 5 :element-type 'double-float :initial-contents vec-1) + (= max-idx (gsl-vector: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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (= max-idx (gsl-vector: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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (= max-idx (gsl-vector:max-index v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "min-index-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) + (min-idx 2)) + (gsl-vector:with-vector + (v1 5 :element-type 'double-float :initial-contents vec-1) + (= min-idx (gsl-vector: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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (= min-idx (gsl-vector: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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (= min-idx (gsl-vector:min-index v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "min-max-indicies-double-float" :category +vector+ + :test-fn + #'(lambda () + (let ((vec-1 (vector 4.0d0 5.0d0 1.0d0 2.0d0 3.0d0)) + (min-max-idx '(2 1))) + (gsl-vector:with-vector + (v1 5 :element-type 'double-float :initial-contents vec-1) + (equal min-max-idx (gsl-vector: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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (equal min-max-idx (gsl-vector: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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (equal min-max-idx (gsl-vector:min-max-indicies v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "min-max-values-double-float" :category +vector+ + :test-fn + #'(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 + (v1 5 :element-type 'double-float :initial-contents vec-1) + (equal min-max-val (gsl-vector: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 + (v1 5 :element-type 'single-float :initial-contents vec-1) + (equal min-max-val (gsl-vector: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 + (v1 5 :element-type 'integer :initial-contents vec-1) + (equal min-max-val (gsl-vector:min-max-values v1)))))) + From cl-gsl-cvs at common-lisp.net Sun Apr 10 02:34:20 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 10 Apr 2005 04:34:20 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050410023420.5952E18C6CB@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv27652 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Apr 10 04:34:19 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.13 cl-gsl/ChangeLog:1.14 --- cl-gsl/ChangeLog:1.13 Thu Apr 7 04:40:39 2005 +++ cl-gsl/ChangeLog Sun Apr 10 04:34:19 2005 @@ -1,3 +1,15 @@ +2005-04-10 Edgar Denny + + * test/test-vector.lisp: + Add several more test. Almost complete except for subvector and + subvector-with-stride tests - which don't work yet. + + * vector.lisp: Fix scale and add-constant functions. Only subvector and + subvector-with-stride functions now have problems. + + * package.lisp: + Minor modifications to exported symbol in gsl-vector package. + 2005-04-07 Edgar Denny * test/test-vector.lisp: Added several new unit tests. From cl-gsl-cvs at common-lisp.net Sun Apr 10 02:34:50 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 10 Apr 2005 04:34:50 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050410023450.CCD7E18C6CB@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv27671 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Apr 10 04:34:50 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.14 cl-gsl/ChangeLog:1.15 --- cl-gsl/ChangeLog:1.14 Sun Apr 10 04:34:19 2005 +++ cl-gsl/ChangeLog Sun Apr 10 04:34:50 2005 @@ -1,7 +1,7 @@ 2005-04-10 Edgar Denny * test/test-vector.lisp: - Add several more test. Almost complete except for subvector and + Add several more tests. Almost complete except for subvector and subvector-with-stride tests - which don't work yet. * vector.lisp: Fix scale and add-constant functions. Only subvector and From cl-gsl-cvs at common-lisp.net Mon Apr 18 00:47:43 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 18 Apr 2005 02:47:43 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/cl-gsl.asd Message-ID: <20050418004743.2B64A18C6FC@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv22644 Modified Files: cl-gsl.asd Log Message: add matrix to defsytem. Date: Mon Apr 18 02:47:42 2005 Author: edenny Index: cl-gsl/cl-gsl.asd diff -u cl-gsl/cl-gsl.asd:1.1.1.1 cl-gsl/cl-gsl.asd:1.2 --- cl-gsl/cl-gsl.asd:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/cl-gsl.asd Mon Apr 18 02:47:42 2005 @@ -41,4 +41,5 @@ (:file "poly" :depends-on ("util" "ffi")) (:file "sf" :depends-on ("util" "ffi")) (:file "vector" :depends-on ("util" "ffi")) + (:file "matrix" :depends-on ("util" "ffi")) )) From cl-gsl-cvs at common-lisp.net Mon Apr 18 00:50:34 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 18 Apr 2005 02:50:34 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ffi.lisp Message-ID: <20050418005034.514DE18C6FC@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv22699 Modified Files: ffi.lisp Log Message: Add matrix types. Date: Mon Apr 18 02:50:33 2005 Author: edenny Index: cl-gsl/ffi.lisp diff -u cl-gsl/ffi.lisp:1.4 cl-gsl/ffi.lisp:1.5 --- cl-gsl/ffi.lisp:1.4 Mon Apr 4 02:44:15 2005 +++ cl-gsl/ffi.lisp Mon Apr 18 02:50:33 2005 @@ -72,94 +72,40 @@ ;; ---------------------------------------------------------------------- -(def-foreign-struct gsl-block - (size :unsigned-long) - (data (* :double))) - -(def-foreign-struct gsl-vector - (size :unsigned-long) - (stride :unsigned-long) - (data (* :double)) - (g-block (* gsl-block)) - (owner :int)) - -(def-foreign-struct gsl-vector-view - (vec (* gsl-vector))) - -;; ---------------------------------------------------------------------- - -(def-foreign-struct gsl-block-float - (size :unsigned-long) - (data (* :float))) - -(def-foreign-struct gsl-vector-float - (size :unsigned-long) - (stride :unsigned-long) - (data (* :float)) - (g-block (* gsl-block-float)) - (owner :int)) - -(def-foreign-struct gsl-vector-float-view - (vec (* gsl-vector-float))) - -;; ---------------------------------------------------------------------- - -(def-foreign-struct gsl-block-int - (size :unsigned-long) - (data (* :int))) - -(def-foreign-struct gsl-vector-int - (size :unsigned-long) - (stride :unsigned-long) - (data (* :int)) - (g-block (* gsl-block-int)) - (owner :int)) - -(def-foreign-struct gsl-vector-int-view - (vec (* gsl-vector-int))) - -;; ---------------------------------------------------------------------- - -(def-foreign-struct gsl-block-complex - (size :unsigned-long) - (data (* :double))) - -(def-foreign-struct gsl-vector-complex - (size :unsigned-long) - (stride :unsigned-long) - (data (* :double)) - (g-block (* gsl-block-complex)) - (owner :int)) - -(def-foreign-struct gsl-vector-complex-view - (vec (* gsl-vector-complex))) - -;; ---------------------------------------------------------------------- - -(def-foreign-struct gsl-block-complex-float - (size :unsigned-long) - (data (* :float))) - -(def-foreign-struct gsl-vector-complex-float - (size :unsigned-long) - (stride :unsigned-long) - (data (* :float)) - (g-block (* gsl-block-complex-float)) - (owner :int)) - -(def-foreign-struct gsl-vector-complex-float-view - (vec (* gsl-vector-complex-float))) +(defmacro def-block-vector-matrix-struct% (struct-postfix data-type) + `(progn + (def-foreign-struct ,(kmrcl:concat-symbol 'gsl-block struct-postfix) + (size :unsigned-long) + (data (* ,data-type))) + + (def-foreign-struct ,(kmrcl:concat-symbol 'gsl-vector struct-postfix) + (size :unsigned-long) + (stride :unsigned-long) + (data (* ,data-type)) + (g-block (* ,(kmrcl:concat-symbol 'gsl-block struct-postfix))) + (owner :int)) + + (def-foreign-struct ,(kmrcl:concat-symbol 'gsl-matrix struct-postfix) + (size1 :unsigned-long) + (size2 :unsigned-long) + (tda :unsigned-long) + (data (* ,data-type)) + (g-block (* ,(kmrcl:concat-symbol 'gsl-block struct-postfix))) + (owner :int)) + + ;; FIXME: is this correct? + (def-foreign-struct ,(kmrcl:concat-symbol 'gsl-vector struct-postfix '-view) + (vec (* ,(kmrcl:concat-symbol 'gsl-vector struct-postfix)))))) + + +(def-block-vector-matrix-struct% "" :double) +(def-block-vector-matrix-struct% "-float" :float) +(def-block-vector-matrix-struct% "-int" :int) +(def-block-vector-matrix-struct% "-complex" :double) +(def-block-vector-matrix-struct% "-complex-float" :float) ;; ---------------------------------------------------------------------- -(def-foreign-struct gsl-matrix - (size1 :unsigned-long) - (size2 :unsigned-long) - (tda :unsigned-long) - (data (* :double)) - (g-block (* gsl-block)) - (owner :int)) - (defmacro register-foreign-types () `(progn ,@(mapcar #'(lambda (elm) `(define-foreign-type ,(car elm) ,(cadr elm))) @@ -184,6 +130,11 @@ (gsl-vector-complex-float-ptr '(* gsl-vector-complex-float)) (gsl-matrix-ptr '(* gsl-matrix)) + (gsl-matrix-float-ptr '(* gsl-matrix-float)) + (gsl-matrix-int-ptr '(* gsl-matrix-int)) + (gsl-matrix-complex-ptr '(* gsl-matrix-complex)) + (gsl-matrix-complex-float-ptr '(* gsl-matrix-complex-float)) + (size-t-ptr '(* size-t)) )))) From cl-gsl-cvs at common-lisp.net Mon Apr 18 00:52:17 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 18 Apr 2005 02:52:17 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/matrix.lisp Message-ID: <20050418005217.68EB418C6FC@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv22734 Modified Files: matrix.lisp Log Message: Initial checkin. Date: Mon Apr 18 02:52:16 2005 Author: edenny Index: cl-gsl/matrix.lisp diff -u cl-gsl/matrix.lisp:1.1.1.1 cl-gsl/matrix.lisp:1.2 --- cl-gsl/matrix.lisp:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/matrix.lisp Mon Apr 18 02:52:16 2005 @@ -17,363 +17,59 @@ ;;;; 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) -;; Function: gsl_block * gsl_block_alloc (size_t n) +(defmacro def-matrix-type-funcs% (typ) + (let ((type-ptr) + (type-val) + (type-val-ptr) + (type-string)) + (cond + ((eq typ 'double-float) + (setq type-ptr 'gsl-matrix-ptr) + (setq type-val :double) + (setq type-val-ptr '(* :double)) + (setq type-string "matrix")) + ((eq typ 'single-float) + (setq type-ptr 'gsl-matrix-float-ptr) + (setq type-val :float) + (setq type-val-ptr '(* :float)) + (setq type-string "matrix_float")) + ((eq typ 'integer) + (setq type-ptr 'gsl-matrix-int-ptr) + (setq type-val :int) + (setq type-val-ptr '(* :int)) + (setq type-string "matrix_int")) + ((equal typ '(complex (double-float))) + (setq type-ptr 'gsl-matrix-complex-ptr) + (setq type-val 'gsl-complex) + (setq type-val-ptr '(* gsl-complex)) + (setq type-string "matrix_complex")) + ((equal typ '(complex (single-float))) + (setq type-ptr 'gsl-matrix-complex-float-ptr) + (setq type-val 'gsl-complex-float) + (setq type-val-ptr '(* gsl-complex-float)) + (setq type-string "matrix_complex_float")) + (t + (error "no matching type."))) + + `(progn + (defun-foreign ,(concatenate 'string "gsl_" type-string "_alloc") + ((size-1 size-t) + (size-2 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_block * gsl_block_calloc (size_t n) - -;; Function: void gsl_block_free (gsl_block * b) - -;; Function: int gsl_block_fwrite (FILE * stream, const gsl_block * b) - -;; Function: int gsl_block_fread (FILE * stream, gsl_block * b) - -;; Function: int gsl_block_fprintf (FILE * stream, const gsl_block * b, const char * format) - -;; Function: int gsl_block_fscanf (FILE * stream, gsl_block * b) - -;; ---------------------------------------------------------------------- - -;; 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) - -;; ---------------------------------------------------------------------- - -(in-package #:cl-gsl-vector) - -(defun-foreign "gsl_vector_alloc" - ((size :unsigned-long)) - gsl-vector-ptr) - -(defun-foreign ("gsl_vector_free" free-vector) - ((v gsl-vector-ptr)) - :void) - -(defun-foreign ("gsl_vector_get" get-element) - ((v gsl-vector-ptr) - (i :unsigned-long)) - :double) - -(defun-foreign ("gsl_vector_set" set-element) - ((v gsl-vector-ptr) - (i :unsigned-long) - (x :double)) - :void) - -(defun-foreign ("gsl_vector_set_all" set-all) - ((v gsl-vector-ptr) - (x :double)) - :void) - -(defun-foreign ("gsl_vector_set_zero" set-zero) - ((v gsl-vector-ptr)) - :void) - -(defun-foreign ("gsl_vector_set_basis" set-basis) - ((v gsl-vector-ptr) - (i :unsigned-long)) - :void) - - -(defun make-vector (size &key element-type initial-element initial-contents) - ;; TODO: make dependent on element-type - (assert (and (typep size 'integer) (> size 0))) - (cond - ((and initial-element initial-contents) - (error "cannot define both initial-element and initial-contents keys")) - (initial-element - (let ((vec (gsl-vector-alloc size))) - (gsl-vector:set-all vec initial-element) - vec)) - (initial-contents - (let ((vec (gsl-vector-alloc size))) - (cond - ((listp initial-contents) - (do ((x initial-contents (cdr x)) - (i 0 (1+ i))) - ((= i size)) - (gsl-vector:set-element vec i (car x)))) - ((vectorp initial-contents) - (do ((i 0 (1+ i))) - ((= i size)) - (gsl-vector:set-element vec i (aref initial-contents i)))) - (t - (error "initial-contents must be either a list or a vector."))) - vec)) - (t - (gsl-vector-alloc size)))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "wrap_gsl_vector_fwrite" - ((fn :cstring) - (v gsl-vector-ptr)) - :int) - -(defun write-to-binary-file (file-name vec) - (let ((status)) - (with-cstring (c-file-name file-name) - (setq status (wrap-gsl-vector-fwrite c-file-name vec))) - status)) - -;; ---------------------------------------------------------------------- - -(defun-foreign "wrap_gsl_vector_fread" - ((fn :cstring) - (v gsl-vector-ptr)) - :int) - -(defun read-from-binary-file (file-name size) - (let ((vec (gsl-vector-alloc size)) - (status)) - (with-cstring (c-file-name file-name) - (setq status (wrap-gsl-vector-fread c-file-name vec))) - (values vec status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "wrap_gsl_vector_fprintf" - ((fn :cstring) - (v gsl-vector-ptr)) - :int) - -(defun write-to-file (file-name vec) - (let ((status)) - (with-cstring (c-file-name file-name) - (setq status (wrap-gsl-vector-fprintf c-file-name vec))) - status)) - -;; ---------------------------------------------------------------------- - -(defun-foreign "wrap_gsl_vector_fscanf" - ((fn :cstring) - (v gsl-vector-ptr)) - :int) - -(defun read-from-file (file-name size) - (let ((vec (gsl-vector-alloc size)) - (status)) - (with-cstring (c-file-name file-name) - (setq status (wrap-gsl-vector-fscanf c-file-name vec))) - (values vec status))) - -;; ---------------------------------------------------------------------- - -;; Function: gsl_vector_const_view gsl_vector_const_subvector (const gsl_vector * v, size_t offset, size_t n) - -(defun-foreign "gsl_vector_subvector" - ((v gsl-vector-ptr) - (offset :unsigned-long) - (n :unsigned-long)) - gsl-vector-view) - -(defun subvector (v offset n) - (let ((view (gsl-vector-subvector v offset n))) - (uffi:get-slot-pointer view 'gsl-vector-view 'vec))) - -;; ---------------------------------------------------------------------- - -;; Function: gsl_vector_const_view gsl_vector_const_subvector_with_stride (const gsl_vector * v, size_t offset, size_t stride, size_t n) - -(defun-foreign "gsl_vector_subvector_with_stride" - ((v gsl-vector-ptr) - (offset :unsigned-long) - (stride :unsigned-long) - (n :unsigned-long)) - gsl-vector-view) - -(defun subvector (v offset stride n) - (let ((view (gsl-vector-subvector-with-stride v offset stride n))) - (uffi:get-slot-pointer view 'gsl-vector-view 'vec))) - -;; ---------------------------------------------------------------------- - -;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v) -;; Function: gsl_vector_const_view gsl_vector_complex_const_real (const gsl_vector_complex *v) - -;; Function: gsl_vector_view gsl_vector_complex_imag (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) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_memcpy" - ((v1 gsl-vector-ptr) - (v2 gsl-vector-ptr)) - :int) - -(defun copy (v-src) - (let* ((n (uffi:get-slot-value v-src 'gsl-vector 'size)) - (v-dest (gsl-vector-alloc n)) - (status)) - (setq status (gsl-vector-memcpy v-dest v-src)) - (values v-dest status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign ("gsl_vector_swap" swap) - ((v1 gsl-vector-ptr) - (v2 gsl-vector-ptr)) - :int) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_swap_elements" - ((v1 gsl-vector-ptr) - (i size-t) - (j size-t)) - :int) - -(defun swap-elements (v i j) - (let ((status (gsl-vector-swap-elements v i j))) - (values v status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_reverse" - ((v1 gsl-vector-ptr)) - :int) - -(defun reverse-vector (v) - (let ((status (gsl-vector-reverse v))) - (values v status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_add" - ((va gsl-vector-ptr) - (vb gsl-vector-ptr)) - :int) - -(defun add (va vb) - (let ((status (gsl-vector-add va vb))) - (values va status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_sub" - ((va gsl-vector-ptr) - (vb gsl-vector-ptr)) - :int) - -(defun sub (va vb) - (let ((status (gsl-vector-sub va vb))) - (values va status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_mul" - ((va gsl-vector-ptr) - (vb gsl-vector-ptr)) - :int) - -(defun mul (va vb) - (let ((status (gsl-vector-mul va vb))) - (values va status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_div" - ((va gsl-vector-ptr) - (vb gsl-vector-ptr)) - :int) - -(defun div (va vb) - (let ((status (gsl-vector-div va vb))) - (values va status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_scale" - ((vec gsl-vector-ptr) - (x :double)) - :int) - -(defun scale (vec x) - (let ((status (gsl-vector-scale vec x))) - (values vec status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_add_constant" - ((vec gsl-vector-ptr) - (x :double)) - :int) - -(defun add-constant (vec x) - (let ((status (gsl-vector-add-constant vec x))) - (values vec status))) - -;; ---------------------------------------------------------------------- - -(defun-foreign ("gsl_vector_max" max-value) - ((vec gsl-vector-ptr)) - :double) - -(defun-foreign ("gsl_vector_min" min-value) - ((vec gsl-vector-ptr)) - :double) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_minmax" - ((vec gsl-vector-ptr) - (min double-ptr) - (max double-ptr)) - :void) - -(defun min-max-values (vec) - (let ((min-ptr (uffi:allocate-foreign-object :double)) - (max-ptr (uffi:allocate-foreign-object :double))) - (gsl-vector-minmax vec min-ptr max-ptr) - (prog1 - (list (uffi:deref-pointer :double min-ptr) - (uffi:deref-pointer :double max-ptr)) - (uffi:free-foreign-object min-ptr) - (uffi:free-foreign-object max-ptr)))) - -;; ---------------------------------------------------------------------- - -(defun-foreign ("gsl_vector_max_index" max-index) - ((vec gsl-vector-ptr)) - size-t) - -(defun-foreign ("gsl_vector_min_index" min-index) - ((vec gsl-vector-ptr)) - size-t) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_minmax_index" - ((vec gsl-vector-ptr) - (min size-t-ptr) - (max size-t-ptr)) - :void) - -(defun min-max-indicies (vec) - (let ((min-ptr (uffi:allocate-foreign-object 'size-t)) - (max-ptr (uffi:allocate-foreign-object 'size-t))) - (gsl-vector-minmax-index vec min-ptr max-ptr) - (prog1 - (list (uffi:deref-pointer 'size-t min-ptr) - (uffi:deref-pointer 'size-t max-ptr)) - (uffi:free-foreign-object min-ptr) - (uffi:free-foreign-object max-ptr)))) - -;; ---------------------------------------------------------------------- - -(defun-foreign "gsl_vector_isnull" - ((vec gsl-vector-ptr)) - :int) - -(defun isnull (vec) - (1/0->t/nil (gsl-vector-isnull vec))) - -;; ---------------------------------------------------------------------- ;; Function: gsl_matrix * gsl_matrix_alloc (size_t n1, size_t n2) From cl-gsl-cvs at common-lisp.net Mon Apr 18 00:53:00 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 18 Apr 2005 02:53:00 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/package.lisp Message-ID: <20050418005300.074AE18C6FC@common-lisp.net> 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 + )) From cl-gsl-cvs at common-lisp.net Mon Apr 18 00:55:10 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 18 Apr 2005 02:55:10 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/vector.lisp Message-ID: <20050418005510.EB9D418C6FC@common-lisp.net> 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) (< i (size o)))) + ,(if is-real + `(,(kmrcl:concat-symbol "gsl-vector-" func-string "get") + (ptr o) i) + `(,(kmrcl:concat-symbol "gsl-" func-string ">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) (< i (size o)))) + ,(if is-real + `(,(kmrcl:concat-symbol "gsl-vector-" func-string "set") + (ptr o) i x) + `(,(kmrcl:concat-symbol "with-" class-string "->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) (< i (size o)))) + (,(kmrcl:concat-symbol "gsl-vector-" func-string "set-basis") + (ptr o) i) + o) + + + (defmethod read-from-binary-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 + "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) (< i (size o)))) + (assert (and (typep j 'integer) (>= 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) From cl-gsl-cvs at common-lisp.net Mon Apr 18 01:00:13 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 18 Apr 2005 03:00:13 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-vector.lisp Message-ID: <20050418010013.0256D18C6F8@common-lisp.net> 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))))) From cl-gsl-cvs at common-lisp.net Mon Apr 18 01:06:38 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 18 Apr 2005 03:06:38 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050418010638.C174818C6F8@common-lisp.net> 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 + + * 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 * test/test-vector.lisp: From cl-gsl-cvs at common-lisp.net Fri Apr 22 02:37:27 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Fri, 22 Apr 2005 04:37:27 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/matrix.lisp Message-ID: <20050422023727.1B1A988665@common-lisp.net> 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) (< i (size-rows o)))) + (assert (and (typep j 'integer) (>= 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) (< i (size-rows o)))) + (assert (and (typep j 'integer) (>= 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 , at 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 + , at 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) - From cl-gsl-cvs at common-lisp.net Fri Apr 22 02:38:08 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Fri, 22 Apr 2005 04:38:08 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/package.lisp Message-ID: <20050422023808.6050E88665@common-lisp.net> 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 )) From cl-gsl-cvs at common-lisp.net Fri Apr 22 02:40:55 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Fri, 22 Apr 2005 04:40:55 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/vector.lisp Message-ID: <20050422024055.AC52F88665@common-lisp.net> 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 (size o)))) + (defmethod get-element ((o ,class-object) i &optional j) + (assert (and (typep i 'integer) (>= 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 (size o)))) + (assert (and (typep i 'integer) (>= 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) From cl-gsl-cvs at common-lisp.net Fri Apr 22 02:41:34 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Fri, 22 Apr 2005 04:41:34 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/c/cwrapperstub.c Message-ID: <20050422024134.E062088665@common-lisp.net> 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; +} From cl-gsl-cvs at common-lisp.net Fri Apr 22 02:44:58 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Fri, 22 Apr 2005 04:44:58 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-vector.lisp Message-ID: <20050422024458.400F788665@common-lisp.net> 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)))))) From cl-gsl-cvs at common-lisp.net Fri Apr 22 02:48:10 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Fri, 22 Apr 2005 04:48:10 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050422024810.590AD88665@common-lisp.net> 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 + + * 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 * test/test-vector.lisp: From cl-gsl-cvs at common-lisp.net Mon Apr 25 02:14:33 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 25 Apr 2005 04:14:33 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/cl-gsl-test.asd Message-ID: <20050425021433.C0EC788665@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv3581 Modified Files: cl-gsl-test.asd Log Message: Added test-matrix. Date: Mon Apr 25 04:14:32 2005 Author: edenny Index: cl-gsl/test/cl-gsl-test.asd diff -u cl-gsl/test/cl-gsl-test.asd:1.3 cl-gsl/test/cl-gsl-test.asd:1.4 --- cl-gsl/test/cl-gsl-test.asd:1.3 Tue Mar 15 04:20:57 2005 +++ cl-gsl/test/cl-gsl-test.asd Mon Apr 25 04:14:32 2005 @@ -36,4 +36,5 @@ (:file "test-sf" :depends-on ("tolerance")) (:file "test-poly" :depends-on ("tolerance")) (:file "test-vector" :depends-on ("tolerance")) + (:file "test-matrix" :depends-on ("tolerance")) )) From cl-gsl-cvs at common-lisp.net Mon Apr 25 02:16:20 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 25 Apr 2005 04:16:20 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-vector.lisp Message-ID: <20050425021620.C067588665@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv4425 Modified Files: test-vector.lisp Log Message: Add comment to explain checking for failure in test. Date: Mon Apr 25 04:16:18 2005 Author: edenny Index: cl-gsl/test/test-vector.lisp diff -u cl-gsl/test/test-vector.lisp:1.5 cl-gsl/test/test-vector.lisp:1.6 --- cl-gsl/test/test-vector.lisp:1.5 Fri Apr 22 04:44:57 2005 +++ cl-gsl/test/test-vector.lisp Mon Apr 25 04:16:18 2005 @@ -515,6 +515,7 @@ #'(lambda () (gsl-array:with-vector (v 5 :element-type 'single-float) (gsl-array:set-basis v 0) + ;; check for failure of isnull (not (gsl-array:isnull v))))) From cl-gsl-cvs at common-lisp.net Mon Apr 25 02:17:38 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 25 Apr 2005 04:17:38 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-matrix.lisp Message-ID: <20050425021738.CCD6A88665@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv4458 Added Files: test-matrix.lisp Log Message: Initial checkin. Date: Mon Apr 25 04:17:38 2005 Author: edenny From cl-gsl-cvs at common-lisp.net Mon Apr 25 02:20:14 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Mon, 25 Apr 2005 04:20:14 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050425022014.C90D188665@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4484 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Mon Apr 25 04:20:14 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.17 cl-gsl/ChangeLog:1.18 --- cl-gsl/ChangeLog:1.17 Fri Apr 22 04:48:09 2005 +++ cl-gsl/ChangeLog Mon Apr 25 04:20:14 2005 @@ -1,3 +1,12 @@ +2005-04-25 Edgar Denny + + * test/test-matrix.lisp: Initial checkin. + + * test/test-vector.lisp: + Add comment to explain checking for failure in test. + + * test/cl-gsl-test.asd: Added test-matrix. + 2005-04-22 Edgar Denny * test/test-vector.lisp: From cl-gsl-cvs at common-lisp.net Thu Apr 28 02:39:40 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 28 Apr 2005 04:39:40 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/matrix.lisp Message-ID: <20050428023940.97C50886F9@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv21385 Modified Files: matrix.lisp Log Message: Added functions that require vectors as well as matricies. Date: Thu Apr 28 04:39:39 2005 Author: edenny Index: cl-gsl/matrix.lisp diff -u cl-gsl/matrix.lisp:1.3 cl-gsl/matrix.lisp:1.4 --- cl-gsl/matrix.lisp:1.3 Fri Apr 22 04:37:26 2005 +++ cl-gsl/matrix.lisp Thu Apr 28 04:39:39 2005 @@ -36,6 +36,7 @@ (let ((type-ptr) (type-val) (type-val-ptr) + (type-vec-ptr) (type-string) (is-real (or (eq typ 'double-float) (eq typ 'single-float) @@ -44,26 +45,31 @@ (cond ((eq typ 'double-float) (setq type-ptr 'gsl-matrix-ptr) + (setq type-vec-ptr 'gsl-vector-ptr) (setq type-val :double) (setq type-val-ptr '(* :double)) (setq type-string "matrix")) ((eq typ 'single-float) (setq type-ptr 'gsl-matrix-float-ptr) + (setq type-vec-ptr 'gsl-vector-float-ptr) (setq type-val :float) (setq type-val-ptr '(* :float)) (setq type-string "matrix_float")) ((eq typ 'integer) (setq type-ptr 'gsl-matrix-int-ptr) + (setq type-vec-ptr 'gsl-vector-int-ptr) (setq type-val :int) (setq type-val-ptr '(* :int)) (setq type-string "matrix_int")) ((equal typ '(complex (double-float))) (setq type-ptr 'gsl-matrix-complex-ptr) + (setq type-vec-ptr 'gsl-vector-complex-ptr) (setq type-val 'gsl-complex) (setq type-val-ptr '(* gsl-complex)) (setq type-string "matrix_complex")) ((equal typ '(complex (single-float))) (setq type-ptr 'gsl-matrix-complex-float-ptr) + (setq type-vec-ptr 'gsl-vector-complex-float-ptr) (setq type-val 'gsl-complex-float) (setq type-val-ptr '(* gsl-complex-float)) (setq type-string "matrix_complex_float")) @@ -140,6 +146,58 @@ (m2 ,type-ptr)) :int) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_get_row") + ((v ,type-vec-ptr) + (m ,type-ptr) + (row size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_get_col") + ((v ,type-vec-ptr) + (m ,type-ptr) + (col size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_row") + ((m ,type-ptr) + (row size-t) + (v ,type-vec-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_col") + ((m ,type-ptr) + (col size-t) + (v ,type-vec-ptr)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap_rows") + ((m ,type-ptr) + (row1 size-t) + (row2 size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap_columns") + ((m ,type-ptr) + (col1 size-t) + (col2 size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap_rowcol") + ((m ,type-ptr) + (row size-t) + (col size-t)) + :int) + + (defun-foreign ,(concatenate 'string "gsl_" type-string "_transpose") + ((m ,type-ptr)) + :int) + + (defun-foreign ,(concatenate 'string + "gsl_" type-string "_transpose_memcpy") + ((m-dest ,type-ptr) + (m-source ,type-ptr)) + :int) + ,(when is-real `(progn (defun-foreign ,(concatenate 'string "gsl_" type-string "_add") @@ -178,24 +236,25 @@ :int) (defun-foreign ,(concatenate 'string "gsl_" type-string "_max") - ((vec ,type-ptr)) + ((m ,type-ptr)) ,type-val) (defun-foreign ,(concatenate 'string "gsl_" type-string "_min") - ((vec ,type-ptr)) + ((m ,type-ptr)) ,type-val) (defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index") - ((vec ,type-ptr) + ((m ,type-ptr) (i-ptr size-t-ptr) (j-ptr size-t-ptr)) :void) + (defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index") - ((vec ,type-ptr) + ((m ,type-ptr) (i-ptr size-t-ptr) (j-ptr size-t-ptr)) :void) @@ -339,6 +398,78 @@ (1/0->t/nil (,(kmrcl:concat-symbol "gsl-matrix-" func-string "isnull") (ptr o)))) + (defmethod get-row ((o ,class-object) row) + (assert (and (typep row 'integer) (>= row 0) (< row (size-rows o)))) + (let* ((vec (make-vector (size-rows o) :element-type (element-type o))) + (status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "get-row") + (ptr vec) (ptr o) row))) + (values vec status))) + + (defmethod get-col ((o ,class-object) col) + (assert (and (typep col 'integer) (>= col 0) (< col (size-cols o)))) + (let* ((vec (make-vector (size-cols o) :element-type (element-type o))) + (status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "get-col") + (ptr vec) (ptr o) col))) + (values vec status))) + + (defmethod set-row ((o ,class-object) row vec) + (assert (and (typep row 'integer) (>= row 0) (< row (size-rows o)))) + (assert (= (size vec) (size-rows o))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "set-row") + (ptr o) row (ptr vec)))) + (values o status))) + + (defmethod set-col ((o ,class-object) col vec) + (assert (and (typep col 'integer) (>= col 0) (< col (size-cols o)))) + (assert (= (size vec) (size-cols o))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "set-col") + (ptr o) col (ptr vec)))) + (values o status))) + + (defmethod swap-rows ((o ,class-object) row1 row2) + (assert (and (typep row1 'integer) (>= row1 0) (< row1 (size-rows o)))) + (assert (and (typep row2 'integer) (>= row2 0) (< row2 (size-rows o)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "swap-rows") + (ptr o) row1 row2))) + (values o status))) + + (defmethod swap-cols ((o ,class-object) col1 col2) + (assert (and (typep col1 'integer) (>= col1 0) (< col1 (size-cols o)))) + (assert (and (typep col2 'integer) (>= col2 0) (< col2 (size-cols o)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "swap-columns") + (ptr o) col1 col2))) + (values o status))) + + (defmethod swap-rowcol ((o ,class-object) row col) + (assert (= (size-rows o) (size-cols o))) + (assert (and (typep row 'integer) (>= row 0) (< row (size-rows o)))) + (assert (and (typep col 'integer) (>= col 0) (< col (size-cols o)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "swap-rowcol") + (ptr o) row col))) + (values o status))) + + (defmethod transpose ((o ,class-object)) + (assert (= (size-rows o) (size-cols o))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "transpose") + (ptr o)))) + (values o status))) + + (defmethod copy-transpose ((o-dest ,class-object) (o-src, class-object)) + (assert (and (= (size-rows o-dest) (size-rows o-src)) + (= (size-cols o-dest) (size-cols o-src)))) + (let* ((status (,(kmrcl:concat-symbol "gsl-matrix-" func-string + "transpose-memcpy") + (ptr o-dest) (ptr o-src)))) + (values o-src status))) + ,(when is-real `(progn (defmethod add ((o1 ,class-object) (o2 ,class-object)) @@ -519,6 +650,24 @@ , at body (free ,m-dest)))) +(defmacro with-copy-transpose ((m-dest m-src) &body body) + `(gsl-array:with-matrix + (,m-dest (size-rows ,m-src) (size-cols ,m-src) + :element-type (element-type ,m-src)) + (copy-transpose ,m-dest ,m-src) + , at body)) + +(defmacro with-matrix-row ((v m row) &body body) + `(let ((,v (get-row ,m ,row))) + (unwind-protect + , at body + (free ,v)))) + +(defmacro with-matrix-col ((v m col) &body body) + `(let ((,v (get-col ,m ,col))) + (unwind-protect + , at body + (free ,v)))) (defun gsl-matrix->lisp-array (m) (let ((a (make-array (list (size-rows m) (size-cols m)) @@ -527,23 +676,3 @@ (dotimes (j (size-cols m)) (setf (aref a i j) (get-element m i j)))) a)) - - - -;; Function: int gsl_matrix_get_row (gsl_vector * v, const gsl_matrix * m, size_t i) - -;; Function: int gsl_matrix_get_col (gsl_vector * v, const gsl_matrix * m, size_t j) - -;; Function: int gsl_matrix_set_row (gsl_matrix * m, size_t i, const gsl_vector * v) - -;; Function: int gsl_matrix_set_col (gsl_matrix * m, size_t j, const gsl_vector * v) - -;; Function: int gsl_matrix_swap_rows (gsl_matrix * m, size_t i, size_t j) - -;; Function: int gsl_matrix_swap_columns (gsl_matrix * m, size_t i, size_t j) - -;; Function: int gsl_matrix_swap_rowcol (gsl_matrix * m, size_t i, size_t j) - -;; Function: int gsl_matrix_transpose_memcpy (gsl_matrix * dest, const gsl_matrix * src) - -;; Function: int gsl_matrix_transpose (gsl_matrix * m) From cl-gsl-cvs at common-lisp.net Thu Apr 28 02:40:55 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 28 Apr 2005 04:40:55 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/package.lisp Message-ID: <20050428024055.D79FD886F9@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv21433 Modified Files: package.lisp Log Message: Added additional matrix related symbols to be exported from cl-array. Date: Thu Apr 28 04:40:55 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.8 cl-gsl/package.lisp:1.9 --- cl-gsl/package.lisp:1.8 Fri Apr 22 04:38:07 2005 +++ cl-gsl/package.lisp Thu Apr 28 04:40:55 2005 @@ -147,4 +147,16 @@ #:with-matrix #:with-matrix-copy #:gsl-matrix->lisp-array + #:get-row + #:with-matrix-row + #:get-col + #:with-matrix-col + #:set-row + #:set-col + #:swap-rows + #:swap-cols + #:swap-rowcol + #:transpose + #:copy-transpose + #:with-copy-transpose )) From cl-gsl-cvs at common-lisp.net Thu Apr 28 02:42:20 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 28 Apr 2005 04:42:20 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-matrix.lisp Message-ID: <20050428024220.12330886F9@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv21499 Modified Files: test-matrix.lisp Log Message: Added tests for newly added functions to matrix.lisp. Date: Thu Apr 28 04:42:19 2005 Author: edenny Index: cl-gsl/test/test-matrix.lisp diff -u cl-gsl/test/test-matrix.lisp:1.1 cl-gsl/test/test-matrix.lisp:1.2 --- cl-gsl/test/test-matrix.lisp:1.1 Mon Apr 25 04:17:38 2005 +++ cl-gsl/test/test-matrix.lisp Thu Apr 28 04:42:19 2005 @@ -29,6 +29,12 @@ (-7.0d0 -8.0d0 -9.0d0 1.0d0 2.0d0) (3.0d0 4.0d0 5.0d0 6.0d0 7.0d0)))) +(defconstant +vector-row-2-double-float+ + (vector -2.0d0 -3.0d0 -4.0d0 -5.0d0 -6.0d0)) + +(defconstant +vector-col-2-double-float+ + (vector 3.0d0 8.0d0 -4.0d0 -9.0d0 5.0d0)) + (defconstant +array-single-float+ (make-array '(5 5) :element-type 'single-float :initial-contents '((1.0 2.0 3.0 4.0 5.0) @@ -37,6 +43,12 @@ (-7.0 -8.0 -9.0 1.0 2.0) (3.0 4.0 5.0 6.0 7.0)))) +(defconstant +vector-row-2-single-float+ + (vector -2.0 -3.0 -4.0 -5.0 -6.0)) + +(defconstant +vector-col-2-single-float+ + (vector 3.0 8.0 -4.0 -9.0 5.0)) + (defconstant +array-integer+ (make-array '(5 5) :element-type 'integer :initial-contents '((1 2 3 4 5) @@ -45,6 +57,12 @@ (-7 -8 -9 1 2) (3 4 5 6 7)))) +(defconstant +vector-row-2-integer+ + (vector -2 -3 -4 -5 -6)) + +(defconstant +vector-col-2-integer+ + (vector 3 8 -4 -9 5)) + (defconstant +array-complex-double-float+ (make-array '(5 5) :element-type '(complex (double-float)) :initial-contents @@ -64,6 +82,15 @@ (complex 5.0d0 6.0d0) (complex 6.0d0 7.0d0) (complex 7.0d0 8.0d0))))) +(defconstant +vector-row-2-complex-double-float+ + (vector (complex -2.0d0 -3.0d0) (complex -3.0d0 -4.0d0) + (complex -4.0d0 -5.0d0) (complex -5.0d0 -6.0d0) + (complex -6.0d0 -7.0d0))) + +(defconstant +vector-col-2-complex-double-float+ + (vector (complex 3.0d0 4.0d0) (complex 9.0d0 9.0d0) (complex -4.0d0 -5.0d0) + (complex -9.0d0 1.0d0) (complex 5.0d0 6.0d0))) + (defconstant +array-complex-single-float+ (make-array '(5 5) :element-type '(complex (single-float)) :initial-contents @@ -83,6 +110,16 @@ (complex 5.0 6.0) (complex 6.0 7.0) (complex 7.0 8.0))))) +(defconstant +vector-row-2-complex-single-float+ + (vector (complex -2.0 -3.0) (complex -3.0 -4.0) (complex -4.0 -5.0) + (complex -5.0 -6.0) (complex -6.0 -7.0))) + +(defconstant +vector-col-2-complex-single-float+ + (vector (complex 3.0 4.0) (complex 9.0 9.0) (complex -4.0 -5.0) + (complex -9.0 1.0) (complex 5.0 6.0))) + +;; ---------------------------------------------------------------------- + (deftest "make-matrix-double-float" :category +matrix+ :test-fn #'(lambda () @@ -1306,3 +1343,726 @@ (gsl-array:with-matrix (m1 5 5 :element-type 'integer :initial-contents +array-integer+) (equalp '(-9 9) (gsl-array:min-max-values m1))))) + +;; ---------------------------------------------------------------------- + +(deftest "get-row-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (let ((v1 (gsl-array:get-row m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-row-2-double-float+) + (gsl-array:free v1)))))) + +(deftest "get-row-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (let ((v1 (gsl-array:get-row m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-row-2-single-float+) + (gsl-array:free v1)))))) + +(deftest "get-row-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:with-matrix-row (v1 m1 2) + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-row-2-integer+))))) + + +(deftest "get-row-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (let ((v1 (gsl-array:get-row m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-row-2-complex-double-float+) + (gsl-array:free v1)))))) + +(deftest "get-row-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (let ((v1 (gsl-array:get-row m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-row-2-complex-single-float+) + (gsl-array:free v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "get-col-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (let ((v1 (gsl-array:get-col m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-col-2-double-float+) + (gsl-array:free v1)))))) + +(deftest "get-col-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (let ((v1 (gsl-array:get-col m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-col-2-single-float+) + (gsl-array:free v1)))))) + +(deftest "get-col-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:with-matrix-col (v1 m1 2) + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-col-2-integer+))))) + + +(deftest "get-col-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (let ((v1 (gsl-array:get-col m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-col-2-complex-double-float+) + (gsl-array:free v1)))))) + +(deftest "get-col-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (let ((v1 (gsl-array:get-col m1 2))) + (prog1 + (equalp (gsl-array:gsl->lisp-vector v1) + +vector-col-2-complex-single-float+) + (gsl-array:free v1)))))) + +;; ---------------------------------------------------------------------- + +(deftest "set-row-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (gsl-array:with-vector (v1 5 :element-type 'double-float + :initial-element 1.0d0) + (gsl-array:set-row m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= i 2) + (when (not (= (gsl-array:get-element m1 i j) + 1.0d0)) + (setq ret nil)) + (when (not (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ i j))) + (setq ret nil)))))))))) + +(deftest "set-row-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (gsl-array:with-vector (v1 5 :element-type 'single-float + :initial-element 1.0) + (gsl-array:set-row m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= i 2) + (when (not (= (gsl-array:get-element m1 i j) + 1.0d0)) + (setq ret nil)) + (when (not (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ i j))) + (setq ret nil)))))))))) + +(deftest "set-row-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:with-vector (v1 5 :element-type 'integer + :initial-element 1) + (gsl-array:set-row m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= i 2) + (when (not (= (gsl-array:get-element m1 i j) + 1.0d0)) + (setq ret nil)) + (when (not (= (gsl-array:get-element m1 i j) + (aref +array-integer+ i j))) + (setq ret nil)))))))))) + +(deftest "set-row-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (gsl-array:with-vector + (v1 5 :element-type '(complex (double-float)) + :initial-element (complex 1.0d0 1.0d0)) + (gsl-array:set-row m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= i 2) + (unless (= (gsl-array:get-element m1 i j) + (complex 1.0d0 1.0d0)) + (setq ret nil)) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ i j)) + (setq ret nil)))))))))) + +(deftest "set-row-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (gsl-array:with-vector + (v1 5 :element-type '(complex (single-float)) + :initial-element (complex 1.0 1.0)) + (gsl-array:set-row m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= i 2) + (unless (= (gsl-array:get-element m1 i j) + (complex 1.0 1.0)) + (setq ret nil)) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ i j)) + (setq ret nil)))))))))) + +;; ---------------------------------------------------------------------- + +(deftest "set-col-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (gsl-array:with-vector (v1 5 :element-type 'double-float + :initial-element 1.0d0) + (gsl-array:set-col m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= j 2) + (when (not (= (gsl-array:get-element m1 i j) + 1.0d0)) + (setq ret nil)) + (when (not (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ i j))) + (setq ret nil)))))))))) + +(deftest "set-col-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (gsl-array:with-vector (v1 5 :element-type 'single-float + :initial-element 1.0) + (gsl-array:set-col m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= j 2) + (when (not (= (gsl-array:get-element m1 i j) + 1.0d0)) + (setq ret nil)) + (when (not (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ i j))) + (setq ret nil)))))))))) + +(deftest "set-col-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:with-vector (v1 5 :element-type 'integer + :initial-element 1) + (gsl-array:set-col m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= j 2) + (when (not (= (gsl-array:get-element m1 i j) + 1.0d0)) + (setq ret nil)) + (when (not (= (gsl-array:get-element m1 i j) + (aref +array-integer+ i j))) + (setq ret nil)))))))))) + +(deftest "set-col-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (gsl-array:with-vector + (v1 5 :element-type '(complex (double-float)) + :initial-element (complex 1.0d0 1.0d0)) + (gsl-array:set-col m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= j 2) + (unless (= (gsl-array:get-element m1 i j) + (complex 1.0d0 1.0d0)) + (setq ret nil)) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ i j)) + (setq ret nil)))))))))) + +(deftest "set-col-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (gsl-array:with-vector + (v1 5 :element-type '(complex (single-float)) + :initial-element (complex 1.0 1.0)) + (gsl-array:set-col m1 2 v1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (if (= j 2) + (unless (= (gsl-array:get-element m1 i j) + (complex 1.0 1.0)) + (setq ret nil)) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ i j)) + (setq ret nil)))))))))) + +;; ---------------------------------------------------------------------- + +(deftest "swap-cols-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (gsl-array:swap-cols m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= j 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ i 3)) + (setq ret nil))) + ((= j 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ i 1)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-cols-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (gsl-array:swap-cols m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= j 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ i 3)) + (setq ret nil))) + ((= j 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ i 1)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-cols-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:swap-cols m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= j 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-integer+ i 3)) + (setq ret nil))) + ((= j 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-integer+ i 1)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-integer+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-cols-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (gsl-array:swap-cols m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= j 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ i 3)) + (setq ret nil))) + ((= j 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ i 1)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-cols-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (gsl-array:swap-cols m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= j 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ i 3)) + (setq ret nil))) + ((= j 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ i 1)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ i j)) + (setq ret nil)))))))))) + +;; ---------------------------------------------------------------------- + +(deftest "swap-rows-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (gsl-array:swap-rows m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= i 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ 3 j)) + (setq ret nil))) + ((= i 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ 1 j)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-rows-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (gsl-array:swap-rows m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= i 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ 3 j)) + (setq ret nil))) + ((= i 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ 1 j)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-rows-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:swap-rows m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= i 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-integer+ 3 j)) + (setq ret nil))) + ((= i 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-integer+ 1 j)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-integer+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-rows-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (gsl-array:swap-rows m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= i 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ 3 j)) + (setq ret nil))) + ((= i 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ 1 j)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ i j)) + (setq ret nil)))))))))) + +(deftest "swap-rows-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (gsl-array:swap-rows m1 1 3) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (cond + ((= i 1) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ 3 j)) + (setq ret nil))) + ((= i 3) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ 1 j)) + (setq ret nil))) + (t + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ i j)) + (setq ret nil)))))))))) + +;; ---------------------------------------------------------------------- + +;; TODO: find out what this function is supposed to do. +;; +;; (deftest "swap-rowcol-double-float" :category +matrix+ +;; :test-fn +;; #'(lambda () +;; (gsl-array:with-matrix +;; (m1 5 5 :element-type 'double-float +;; :initial-contents +array-double-float+) +;; (gsl-array:swap-rowcol m1 1 3) +;; (let ((ret t)) +;; (dotimes (i 5 ret) +;; (dotimes (j 5) +;; (if (or (= i 1) (= j 3)) +;; (unless (= (gsl-array:get-element m1 i j) +;; (aref +array-double-float+ j i)) +;; (setq ret nil)) +;; (unless (= (gsl-array:get-element m1 i j) +;; (aref +array-double-float+ i j)) +;; (setq ret nil))))))))) + +;; ---------------------------------------------------------------------- + +(deftest "transpose-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (gsl-array:transpose m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-double-float+ j i)) + (setq ret nil)))))))) + +(deftest "transpose-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (gsl-array:transpose m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-single-float+ j i)) + (setq ret nil)))))))) + +(deftest "transpose-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:transpose m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-integer+ j i)) + (setq ret nil)))))))) + +(deftest "transpose-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (gsl-array:transpose m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-double-float+ j i)) + (setq ret nil)))))))) + +(deftest "transpose-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (gsl-array:transpose m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (aref +array-complex-single-float+ j i)) + (setq ret nil)))))))) + +;; ---------------------------------------------------------------------- + +(deftest "copy-transpose-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type 'double-float + :initial-contents +array-double-float+) + (gsl-array:with-matrix (m2 5 5 :element-type 'double-float) + (gsl-array:copy-transpose m2 m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (gsl-array:get-element m2 j i)) + (setq ret nil))))))))) + +(deftest "copy-transpose-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type 'single-float + :initial-contents +array-single-float+) + (gsl-array:with-copy-transpose (m2 m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (gsl-array:get-element m2 j i)) + (setq ret nil))))))))) + +(deftest "copy-transpose-integer" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type 'integer + :initial-contents +array-integer+) + (gsl-array:with-copy-transpose (m2 m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (gsl-array:get-element m2 j i)) + (setq ret nil))))))))) + +(deftest "copy-transpose-complex-double-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (double-float)) + :initial-contents +array-complex-double-float+) + (gsl-array:with-copy-transpose (m2 m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (gsl-array:get-element m2 j i)) + (setq ret nil))))))))) + +(deftest "copy-transpose-complex-single-float" :category +matrix+ + :test-fn + #'(lambda () + (gsl-array:with-matrix + (m1 5 5 :element-type '(complex (single-float)) + :initial-contents +array-complex-single-float+) + (gsl-array:with-copy-transpose (m2 m1) + (let ((ret t)) + (dotimes (i 5 ret) + (dotimes (j 5) + (unless (= (gsl-array:get-element m1 i j) + (gsl-array:get-element m2 j i)) + (setq ret nil))))))))) From cl-gsl-cvs at common-lisp.net Thu Apr 28 02:43:56 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Thu, 28 Apr 2005 04:43:56 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050428024356.1DE21886F9@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv21570 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Thu Apr 28 04:43:55 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.18 cl-gsl/ChangeLog:1.19 --- cl-gsl/ChangeLog:1.18 Mon Apr 25 04:20:14 2005 +++ cl-gsl/ChangeLog Thu Apr 28 04:43:55 2005 @@ -1,3 +1,14 @@ +2005-04-28 Edgar Denny + + * test/test-matrix.lisp: + Added tests for newly added functions to matrix.lisp. + + * package.lisp: + Added additional matrix related symbols to be exported from cl-array. + + * matrix.lisp: + Added functions that require vectors as well as matricies. + 2005-04-25 Edgar Denny * test/test-matrix.lisp: Initial checkin. From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:32:16 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:32:16 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/Makefile.common Message-ID: <20050430223216.EBF7088716@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4038 Modified Files: Makefile.common Log Message: Changed name of cwrapperstub.so to gsl_cwrapper.so Date: Sun May 1 00:32:16 2005 Author: edenny Index: cl-gsl/Makefile.common diff -u cl-gsl/Makefile.common:1.1.1.1 cl-gsl/Makefile.common:1.2 --- cl-gsl/Makefile.common:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/Makefile.common Sun May 1 00:32:15 2005 @@ -2,4 +2,4 @@ #### Author: Edgar Denny #### Common Makefile options -STUBS= cwrapperstub.$(SHLIB_SUFFIX) +STUBS= gsl_cwrapper.$(SHLIB_SUFFIX) From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:33:11 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:33:11 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/cl-gsl.asd Message-ID: <20050430223311.33A3488671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4087 Modified Files: cl-gsl.asd Log Message: Added permutation to the defsystem. Date: Sun May 1 00:33:10 2005 Author: edenny Index: cl-gsl/cl-gsl.asd diff -u cl-gsl/cl-gsl.asd:1.2 cl-gsl/cl-gsl.asd:1.3 --- cl-gsl/cl-gsl.asd:1.2 Mon Apr 18 02:47:42 2005 +++ cl-gsl/cl-gsl.asd Sun May 1 00:33:10 2005 @@ -42,4 +42,5 @@ (:file "sf" :depends-on ("util" "ffi")) (:file "vector" :depends-on ("util" "ffi")) (:file "matrix" :depends-on ("util" "ffi")) + (:file "permutation" :depends-on ("util" "ffi")) )) From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:34:26 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:34:26 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ffi.lisp Message-ID: <20050430223426.2E05688671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4147 Modified Files: ffi.lisp Log Message: Added permutation structure and pointer. Date: Sun May 1 00:34:25 2005 Author: edenny Index: cl-gsl/ffi.lisp diff -u cl-gsl/ffi.lisp:1.5 cl-gsl/ffi.lisp:1.6 --- cl-gsl/ffi.lisp:1.5 Mon Apr 18 02:50:33 2005 +++ cl-gsl/ffi.lisp Sun May 1 00:34:25 2005 @@ -56,20 +56,22 @@ ;; ---------------------------------------------------------------------- -;; TODO: size_t may not always be unsigned long, could also be unsigned int -;; on some systems? (define-foreign-type size-t :unsigned-long) (def-foreign-struct gsl-complex (dat (:array :double 2))) (def-foreign-struct gsl-poly-complex-workspace - (nc :unsigned-long) + (nc size-t) (matrix (* :double))) (def-foreign-struct gsl-complex-float (dat (:array :float 2))) +(def-foreign-struct gsl-permutation-struct + (size size-t) + (data (* size-t))) + ;; ---------------------------------------------------------------------- (defmacro def-block-vector-matrix-struct% (struct-postfix data-type) @@ -136,6 +138,8 @@ (gsl-matrix-complex-float-ptr '(* gsl-matrix-complex-float)) (size-t-ptr '(* size-t)) + + (gsl-permutation-ptr '(* gsl-permutation-struct)) )))) (register-foreign-types) From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:35:06 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:35:06 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/load-libraries.lisp Message-ID: <20050430223506.ADD1788671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4187 Modified Files: load-libraries.lisp Log Message: changed cwrappersub to gsl_cwrapper. Date: Sun May 1 00:35:05 2005 Author: edenny Index: cl-gsl/load-libraries.lisp diff -u cl-gsl/load-libraries.lisp:1.1.1.1 cl-gsl/load-libraries.lisp:1.2 --- cl-gsl/load-libraries.lisp:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/load-libraries.lisp Sun May 1 00:35:05 2005 @@ -42,7 +42,7 @@ (defun get-libs-list () (cons - "cwrapperstub" + "gsl_cwrapper" (remove-if #'(lambda (elm) (not (cl-ppcre:scan "^lib" elm))) (mapcar #'(lambda (elm) (cl-ppcre:regex-replace "^-l" elm "lib")) (butlast From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:36:03 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:36:03 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/package.lisp Message-ID: <20050430223603.F1A2B88671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4222 Modified Files: package.lisp Log Message: Added symbols to be exported from cl-array due to permutations. Date: Sun May 1 00:36:03 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.9 cl-gsl/package.lisp:1.10 --- cl-gsl/package.lisp:1.9 Thu Apr 28 04:40:55 2005 +++ cl-gsl/package.lisp Sun May 1 00:36:03 2005 @@ -159,4 +159,25 @@ #:transpose #:copy-transpose #:with-copy-transpose + + ;; from permutation + #:permutation-init + #:valid + #:reverse-permutation + #:next + #:prev + #:inverse + #:with-permutation-inverse + #:permute-vector + #:permute-vector-inverse + #:make-permutation + #:with-permutation-copy + #:with-permutation-mul + #:linear->canonical + #:with-permutation-linear->canonical + #:canonical->linear + #:with-permutation-canonical->linear + #:inversions + #:linear-cycles + #:canonical-cycles )) From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:37:00 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:37:00 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/vector.lisp Message-ID: <20050430223700.045D288671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4279 Modified Files: vector.lisp Log Message: Added a TODO note. Date: Sun May 1 00:37:00 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.9 cl-gsl/vector.lisp:1.10 --- cl-gsl/vector.lisp:1.9 Fri Apr 22 04:40:54 2005 +++ cl-gsl/vector.lisp Sun May 1 00:37:00 2005 @@ -25,6 +25,7 @@ (size :accessor size :initarg :size) (element-type :accessor element-type :initarg :element-type))) +;; TODO: have a (defmethod initialize-instance : after) that calls alloc? (defclass gsl-vector-double-float (gsl-vector) ()) (defclass gsl-vector-single-float (gsl-vector) ()) From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:37:33 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:37:33 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/build/Makefile Message-ID: <20050430223733.AA45488671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/build In directory common-lisp.net:/tmp/cvs-serv4310 Modified Files: Makefile Log Message: Changed cwrappersub to gsl_cwrapper. Date: Sun May 1 00:37:33 2005 Author: edenny Index: cl-gsl/build/Makefile diff -u cl-gsl/build/Makefile:1.1.1.1 cl-gsl/build/Makefile:1.2 --- cl-gsl/build/Makefile:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/build/Makefile Sun May 1 00:37:33 2005 @@ -12,4 +12,4 @@ $(RM) $(STUBS) install_cwrapper: - install -m 0644 cwrapperstub.$(SHLIB_SUFFIX) $(CWRAPPER_LIBDIR) + install -m 0644 gsl_cwrapper.$(SHLIB_SUFFIX) $(CWRAPPER_LIBDIR) From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:38:08 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:38:08 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/c/Makefile Message-ID: <20050430223808.A19E288671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/c In directory common-lisp.net:/tmp/cvs-serv4341 Modified Files: Makefile Log Message: Changed cwrapperstub to gsl_cwrapper. Date: Sun May 1 00:38:08 2005 Author: edenny Index: cl-gsl/c/Makefile diff -u cl-gsl/c/Makefile:1.1.1.1 cl-gsl/c/Makefile:1.2 --- cl-gsl/c/Makefile:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/c/Makefile Sun May 1 00:38:08 2005 @@ -8,7 +8,7 @@ all: $(STUBS) mv $(STUBS) ../build/ -cwrapperstub.$(SHLIB_SUFFIX): cwrapperstub.c +gsl_cwrapper.$(SHLIB_SUFFIX): cwrapperstub.c $(CC) $(CW_CFLAGS) -o $@ $< $(CW_LDFLAGS) clean: From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:38:44 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:38:44 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/c/cwrapperstub.c Message-ID: <20050430223844.195D288671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/c In directory common-lisp.net:/tmp/cvs-serv4368 Modified Files: cwrapperstub.c Log Message: Added wrappers to read and write permutations from file. Date: Sun May 1 00:38:43 2005 Author: edenny Index: cl-gsl/c/cwrapperstub.c diff -u cl-gsl/c/cwrapperstub.c:1.4 cl-gsl/c/cwrapperstub.c:1.5 --- cl-gsl/c/cwrapperstub.c:1.4 Fri Apr 22 04:41:33 2005 +++ cl-gsl/c/cwrapperstub.c Sun May 1 00:38:43 2005 @@ -817,3 +817,53 @@ return ret; } + +/* ----------------------------------------------------------------- */ + +int wrap_gsl_permutation_fwrite(char *fn, const gsl_permutation *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "wb"); + ret = gsl_permutation_fwrite(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_permutation_fread(char *fn, gsl_permutation *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "rb"); + ret = gsl_permutation_fread(stream, m); + fclose(stream); + + return ret; +} + +int wrap_gsl_permutation_fprintf(char *fn, const gsl_permutation *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "w"); + ret = gsl_permutation_fprintf(stream, m, "%d"); + fclose(stream); + + return ret; +} + +int wrap_gsl_permutation_fscanf(char *fn, gsl_permutation *m) +{ + FILE* stream; + int ret; + + stream = fopen(fn, "r"); + ret = gsl_permutation_fscanf(stream, m); + fclose(stream); + + return ret; +} From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:39:47 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:39:47 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/test/test-vector.lisp Message-ID: <20050430223947.8F4B988671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv4422 Modified Files: test-vector.lisp Log Message: Slight sylistic changes to a few unit tests. Date: Sun May 1 00:39:46 2005 Author: edenny Index: cl-gsl/test/test-vector.lisp diff -u cl-gsl/test/test-vector.lisp:1.6 cl-gsl/test/test-vector.lisp:1.7 --- cl-gsl/test/test-vector.lisp:1.6 Mon Apr 25 04:16:18 2005 +++ cl-gsl/test/test-vector.lisp Sun May 1 00:39:46 2005 @@ -76,72 +76,65 @@ (deftest "make-vector-double-float-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-array:make-vector 5 - :element-type 'double-float - :initial-element 1.0d0)) - (ret t)) - (dotimes (i 5 ret) - (unless (= (gsl-array:get-element v i) 1.0d0) - (setq ret nil))) - (gsl-array:free v) - ret))) + (let ((v (gsl-array:make-vector 5 :element-type 'double-float + :initial-element 1.0d0))) + (prog1 + (dotimes (i 5 t) + (unless (= (gsl-array:get-element v i) 1.0d0) + (return nil))) + (gsl-array:free v))))) (deftest "make-vector-single-float-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-array:make-vector 5 - :element-type 'single-float - :initial-element 1.0)) - (ret t)) - (dotimes (i 5 ret) - (unless (= (gsl-array:get-element v i) 1.0) - (setq ret nil))) - (gsl-array:free v) - ret))) + (let ((v (gsl-array:make-vector 5 :element-type 'single-float + :initial-element 1.0))) + (prog1 + (dotimes (i 5 t) + (unless (= (gsl-array:get-element v i) 1.0) + (return nil))) + (gsl-array:free v))))) (deftest "make-vector-integer-initial-element" :category +vector+ :test-fn #'(lambda () - (let ((v (gsl-array:make-vector 5 - :element-type 'integer - :initial-element 1)) - (ret t)) - (dotimes (i 5 ret) - (unless (= (gsl-array:get-element v i) 1) - (setq ret nil))) - (gsl-array:free v) - ret))) + (let ((v (gsl-array:make-vector 5 :element-type 'integer + :initial-element 1))) + (prog1 + (dotimes (i 5 t) + (unless (= (gsl-array:get-element v i) 1) + (return nil))) + (gsl-array:free v))))) (deftest "make-vector-complex-double-float-initial-element" :category +vector+ :test-fn #'(lambda () - (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-array:get-element v i) (complex 1.0d0 1.0d0)) - (setq ret nil))) - (gsl-array:free v) - ret))) + (let ((v (gsl-array:make-vector 5 :element-type + '(complex (double-float)) + :initial-element + (complex 1.0d0 1.0d0)))) + (prog1 + (dotimes (i 5 t) + (unless (= (gsl-array:get-element v i) + (complex 1.0d0 1.0d0)) + (return nil))) + (gsl-array:free v))))) + (deftest "make-vector-complex-single-float-initial-element" :category +vector+ :test-fn #'(lambda () (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-array:get-element v i) (complex 1.0 1.0)) - (setq ret nil))) - (gsl-array:free v) - ret))) + '(complex (single-float)) + :initial-element + (complex 1.0 1.0)))) + (prog1 + (dotimes (i 5 t) + (unless (= (gsl-array:get-element v i) (complex 1.0 1.0)) + (return nil))) + (gsl-array:free v))))) ;; ---------------------------------------------------------------------- @@ -248,20 +241,18 @@ #'(lambda () (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-array:get-element v i) 5.0) - (setq ret nil))))))) + (dotimes (i 5 t) + (unless (= (gsl-array:get-element v i) 5.0) + (return nil)))))) (deftest "set-all-integer" :category +vector+ :test-fn #'(lambda () (gsl-array:with-vector (v 5 :element-type 'integer) (gsl-array:set-all v 5) - (let ((ret t)) - (dotimes (i 5 ret) - (unless (= (gsl-array:get-element v i) 5) - (setq ret nil))))))) + (dotimes (i 5 t) + (unless (= (gsl-array:get-element v i) 5) + (return nil)))))) (deftest "set-all-complex-double-float" :category +vector+ :test-fn From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:41:11 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:41:11 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/permutation.lisp Message-ID: <20050430224111.2D4A388671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4486 Added Files: permutation.lisp Log Message: Initial checkin. Date: Sun May 1 00:41:10 2005 Author: edenny From cl-gsl-cvs at common-lisp.net Sat Apr 30 22:41:37 2005 From: cl-gsl-cvs at common-lisp.net (cl-gsl-cvs at common-lisp.net) Date: Sun, 1 May 2005 00:41:37 +0200 (CEST) Subject: [cl-gsl-cvs] CVS update: cl-gsl/ChangeLog Message-ID: <20050430224137.5932A88671@common-lisp.net> Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv4518 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun May 1 00:41:36 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.19 cl-gsl/ChangeLog:1.20 --- cl-gsl/ChangeLog:1.19 Thu Apr 28 04:43:55 2005 +++ cl-gsl/ChangeLog Sun May 1 00:41:36 2005 @@ -1,3 +1,29 @@ +2005-04-30 Edgar Denny + + * permutation.lisp: Initial checkin. + + * test/test-vector.lisp: Slight sylistic changes to a few unit tests. + + * c/cwrapperstub.c: + Added wrappers to read and write permutations from file. + + * c/Makefile: Changed cwrapperstub to gsl_cwrapper. + + * build/Makefile: Changed cwrappersub to gsl_cwrapper. + + * vector.lisp: Added a TODO note. + + * package.lisp: + Added symbols to be exported from cl-array due to permutations. + + * load-libraries.lisp: changed cwrappersub to gsl_cwrapper. + + * ffi.lisp: Added permutation structure and pointer. + + * cl-gsl.asd: Added permutation to the defsystem. + + * Makefile.common: Changed name of cwrapperstub.so to gsl_cwrapper.so + 2005-04-28 Edgar Denny * test/test-matrix.lisp: