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

[cl-gsl-cvs] CVS update: cl-gsl/vector.lisp
by edenny＠common-lisp.net 15 Mar '05

15 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv31424 Modified Files: vector.lisp Log Message: Can now actually set and get values from complex vectors. Bindings are still leaky though. Date: Tue Mar 15 04:17:29 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.3 cl-gsl/vector.lisp:1.4 --- cl-gsl/vector.lisp:1.3 Sat Mar 5 05:31:41 2005 +++ cl-gsl/vector.lisp Tue Mar 15 04:17:29 2005 @@ -231,6 +231,38 @@ ,type-ptr)))) +(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) (def-vector-type-funcs% integer) @@ -292,10 +324,10 @@ ((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-get - (gsl-vec-ptr v) i))) + (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-get (gsl-vec-ptr v) i))) + (gsl-complex->complex (gsl-vector-complex-ptr (gsl-vec-ptr v) i))) (t (error "No matching type")))) @@ -313,10 +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))) - (gsl-vector-complex-float-set (gsl-vec-ptr v) i - (complex->gsl-complex-float x))) + (wrap-gsl-vector-complex-float-set (gsl-vec-ptr v) i + (complex->gsl-complex-float-ptr x))) ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-set (gsl-vec-ptr v) i (complex->gsl-complex x))) + (wrap-gsl-vector-complex-set (gsl-vec-ptr v) i + (complex->gsl-complex-ptr x))) (t (error "No matching type")))) @@ -332,10 +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))) - (gsl-vector-complex-float-set-all (gsl-vec-ptr v) - (complex->gsl-complex-float x))) + (wrap-gsl-vector-complex-float-set-all (gsl-vec-ptr v) + (complex->gsl-complex-float-ptr x))) ((equal (gsl-vec-element-type v) '(complex (double-float))) - (gsl-vector-complex-set-all (gsl-vec-ptr v) (complex->gsl-complex x))) + (wrap-gsl-vector-complex-set-all (gsl-vec-ptr v) + (complex->gsl-complex-ptr x))) (t (error "No matching type")))) @@ -369,11 +403,9 @@ ((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) - (complex->gsl-complex-float i))) + (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) - (complex->gsl-complex i))) + (gsl-vector-complex-set-basis (gsl-vec-ptr v) i)) (t (error "No matching type")))) @@ -864,3 +896,4 @@ ;; Function: gsl_vector_view gsl_vector_view_array_with_stride (double * base, size_t stride, size_t n) ;; Function: gsl_vector_const_view gsl_vector_const_view_array_with_stride (const double * base, size_t stride, size_t n) +

1 0

[cl-gsl-cvs] CVS update: cl-gsl/package.lisp
by edenny＠common-lisp.net 15 Mar '05

15 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv31046 Modified Files: package.lisp Log Message: Changes needed for complex vectors. Date: Tue Mar 15 04:15:57 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.2 cl-gsl/package.lisp:1.3 --- cl-gsl/package.lisp:1.2 Fri Mar 4 02:55:10 2005 +++ cl-gsl/package.lisp Tue Mar 15 04:15:57 2005 @@ -40,8 +40,8 @@ #:gsl-complex-float->complex #:lisp-vec->c-array #:complex-packed-array->lisp-vec - #:complex->gsl-complex - #:complex->gsl-complex-float + #:complex->gsl-complex-ptr + #:complex->gsl-complex-float-ptr #:c-array->lisp-vec #:defconstant-export #:register-constants @@ -94,6 +94,10 @@ (:nicknames #:gsl-vector) (:use #:cl #:cl-gsl) (:export + #:gsl-vec-size + #:gsl-vec-element-type + #:gsl-vec-ptr + #:free #:make-vector #:get-element

1 0

[cl-gsl-cvs] CVS update: cl-gsl/ffi.lisp
by edenny＠common-lisp.net 15 Mar '05

15 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv30766 Modified Files: ffi.lisp Log Message: Changes needed for complex vectors. Date: Tue Mar 15 04:15:21 2005 Author: edenny Index: cl-gsl/ffi.lisp diff -u cl-gsl/ffi.lisp:1.2 cl-gsl/ffi.lisp:1.3 --- cl-gsl/ffi.lisp:1.2 Fri Mar 4 02:52:38 2005 +++ cl-gsl/ffi.lisp Tue Mar 15 04:15:20 2005 @@ -121,12 +121,12 @@ (def-foreign-struct gsl-block-complex (size :unsigned-long) - (data (* gsl-complex))) + (data (* :double))) (def-foreign-struct gsl-vector-complex (size :unsigned-long) (stride :unsigned-long) - (data (* gsl-complex)) + (data (* :double)) (g-block (* gsl-block-complex)) (owner :int)) @@ -137,12 +137,12 @@ (def-foreign-struct gsl-block-complex-float (size :unsigned-long) - (data (* gsl-complex-float))) + (data (* :float))) (def-foreign-struct gsl-vector-complex-float (size :unsigned-long) (stride :unsigned-long) - (data (* gsl-complex-float)) + (data (* :float)) (g-block (* gsl-block-complex-float)) (owner :int)) @@ -200,15 +200,15 @@ ;; ---------------------------------------------------------------------- -(defun gsl-complex->complex (z) - (declare (gsl-complex-def z)) - (let ((dat-array (uffi:get-slot-value z (:array :double) 'cl-gsl::dat))) +(defun gsl-complex->complex (z-ptr) + ;; TODO: this seems to work with pointers and values +;; (declare (gsl-complex-def z)) + (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) - (declare (gsl-complex-float-def z)) - (let ((dat-array (uffi:get-slot-value z (:array :float) 'cl-gsl::dat))) +(defun gsl-complex-float->complex (z-ptr) + (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)))) @@ -216,19 +216,19 @@ ;; How do we free it? ;; Replace with a with-complex->gsl-complex macro that cleans up after ;; itself -(defun complex->gsl-complex (z) +(defun complex->gsl-complex-ptr (z) (let* ((z-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (dat-array (uffi:get-slot-value z-ptr (:array :float) 'cl-gsl::dat))) + (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 (z) +(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 :double 0) (realpart z)) - (setf (uffi:deref-array dat-array :double 1) (imagpart z)) + (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))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/ChangeLog
by edenny＠common-lisp.net 13 Mar '05

13 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv18042 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Sun Mar 13 01:55:30 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.5 cl-gsl/ChangeLog:1.6 --- cl-gsl/ChangeLog:1.5 Wed Mar 9 04:11:50 2005 +++ cl-gsl/ChangeLog Sun Mar 13 01:55:30 2005 @@ -1,3 +1,12 @@ +2005-03-13 Edgar Denny <edgardenny(a)comcast.net> + + * tolerance.lisp, test-poly.lisp: Initial checkin. + + * test-sf.lisp: Moved tolerance functions to a separate file. + + * cl-gsl-test.asd: + Added tolerance and test-poly files to the dependencies. + 2005-03-09 Edgar Denny <edgardenny(a)comcast.net> * test-sf.lisp: Additional unit tests.

1 0

[cl-gsl-cvs] CVS update: cl-gsl/test/tolerance.lisp
by edenny＠common-lisp.net 13 Mar '05

13 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv18007 Added Files: tolerance.lisp Log Message: Initial checkin. Date: Sun Mar 13 01:52:44 2005 Author: edenny

1 0

[cl-gsl-cvs] CVS update: cl-gsl/test/test-poly.lisp
by edenny＠common-lisp.net 13 Mar '05

13 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv17987 Added Files: test-poly.lisp Log Message: Initial checkin. Date: Sun Mar 13 01:52:02 2005 Author: edenny

1 0

[cl-gsl-cvs] CVS update: cl-gsl/test/test-sf.lisp
by edenny＠common-lisp.net 13 Mar '05

13 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv17962 Modified Files: test-sf.lisp Log Message: Moved tolerance functions to a separate file. Date: Sun Mar 13 01:50:49 2005 Author: edenny Index: cl-gsl/test/test-sf.lisp diff -u cl-gsl/test/test-sf.lisp:1.4 cl-gsl/test/test-sf.lisp:1.5 --- cl-gsl/test/test-sf.lisp:1.4 Wed Mar 9 04:11:04 2005 +++ cl-gsl/test/test-sf.lisp Sun Mar 13 01:50:49 2005 @@ -19,20 +19,7 @@ (in-package #:cl-gsl-test) -(defconstant +dbl-epsilon+ 2.2204460492503131d-16) - -(defconstant +tol0+ (/ +dbl-epsilon+ 2.0d0)) -(defconstant +tol+1+ (* +tol0+ 10.0d0)) -(defconstant +tol-1+ (/ +tol0+ 10.0d0)) -(defconstant +tol+2+ (* +tol0+ 100.0d0)) -(defconstant +tol-2+ (/ +tol0+ 100.0d0)) -(defconstant +tol+3+ (* +tol0+ 1000.0d0)) -(defconstant +tol-3+ (/ +tol0+ 1000.0d0)) - (defconstant +sf+ "sf") - -(defun tol< (x y tol) - (< (abs (- x y)) tol)) (defmacro sf-deftest (func-name-str param-list result tolerance) `(deftest ,func-name-str :category +sf+

1 0

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

13 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl/test In directory common-lisp.net:/tmp/cvs-serv17936 Modified Files: cl-gsl-test.asd Log Message: Added tolerance and test-poly files to the dependencies. Date: Sun Mar 13 01:49:36 2005 Author: edenny Index: cl-gsl/test/cl-gsl-test.asd diff -u cl-gsl/test/cl-gsl-test.asd:1.1.1.1 cl-gsl/test/cl-gsl-test.asd:1.2 --- cl-gsl/test/cl-gsl-test.asd:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/test/cl-gsl-test.asd Sun Mar 13 01:49:36 2005 @@ -32,5 +32,7 @@ :depends-on (:clunit :cl-gsl) :components ((:file "package") - (:file "test-sf" :depends-on ("package")) + (:file "tolerance" :depends-on ("package")) + (:file "test-sf" :depends-on ("tolerance")) + (:file "test-poly" :depends-on ("tolerance")) ))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/poly.lisp
by edenny＠common-lisp.net 13 Mar '05

13 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv17913 Modified Files: poly.lisp Log Message: Added divided difference functions. Date: Sun Mar 13 01:48:25 2005 Author: edenny Index: cl-gsl/poly.lisp diff -u cl-gsl/poly.lisp:1.1.1.1 cl-gsl/poly.lisp:1.2 --- cl-gsl/poly.lisp:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/poly.lisp Sun Mar 13 01:48:25 2005 @@ -170,72 +170,72 @@ (ret-val)) (setq ret-val (gsl-poly-complex-solve a-ptr len w z-ptr)) (gsl-poly-complex-workspace-free w) - (prog1 - ;; FIXME: where is ret-val in result? + (multiple-value-prog1 (values (complex-packed-array->lisp-vec z-ptr (* 2 (1- len))) ret-val) (uffi:free-foreign-object z-ptr)))) ;; ---------------------------------------------------------------------- -;; (defun-foreign "gsl_poly_dd_int" -;; ((dd double-ptr) -;; (xa double-ptr) -;; (ya double-ptr) -;; (size :unsigned-long)) -;; :int) - -;; (defun-foreign "gsl_poly_dd_eval" -;; ((dd double-ptr) -;; (xa double-ptr) -;; (size :unsigned-long) -;; (x :double)) -;; :double) - -;; (defun-foreign "gsl_poly_dd_taylor" -;; ((c double-ptr) -;; (xp :double) -;; (dd double-ptr) -;; (xa double-ptr) -;; (size :unsigned-long) -;; (w double-ptr)) -;; :int) - - -;; (defun dd-int (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)) - - - -;; Function: int gsl_poly_dd_init (double dd[], const double xa[], const double ya[], size_t size) -;; This function computes a divided-difference representation of the interpolating polynomial for the points (xa, ya) stored in the arrays xa and ya of length size. -;; On output the divided-differences of (xa,ya) are stored in the array dd, also of length size. - -;; Function: double gsl_poly_dd_eval (const double dd[], const double xa[], const size_t size, const double x) -;; This function evaluates the polynomial stored in divided-difference form in the arrays dd and xa of length size at the point x. - -;; Function: int gsl_poly_dd_taylor (double c[], double xp, const double dd[], const double xa[], size_t size, double w[]) -;; This function converts the divided-difference representation of a polynomial to a Taylor expansion. The divided-difference representation is supplied in the -;; arrays dd and xa of length size. On output the Taylor coefficients of the polynomial expanded about the point xp are stored in the array c also of length size. A -;; workspace of length size must be provided in the array w. - - - +(defun-foreign "gsl_poly_dd_init" + ((dd double-ptr) + (xa double-ptr) + (ya double-ptr) + (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)))) +;; ---------------------------------------------------------------------- -;; #define GSL_REAL(z) ((z).dat[0]) -;; #define GSL_IMAG(z) ((z).dat[1]) -;; #define GSL_COMPLEX_P(zp) ((zp)->dat) -;; #define GSL_COMPLEX_P_REAL(zp) ((zp)->dat[0]) -;; #define GSL_COMPLEX_P_IMAG(zp) ((zp)->dat[1]) -;; #define GSL_COMPLEX_EQ(z1,z2) (((z1).dat[0] == (z2).dat[0]) && ((z1).dat[1] == (z2).dat[1])) +(defun-foreign "gsl_poly_dd_eval" + ((dd double-ptr) + (xa double-ptr) + (size :unsigned-long) + (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)))) -;; #define GSL_SET_COMPLEX(zp,x,y) do {(zp)->dat[0]=(x); (zp)->dat[1]=(y);} while(0) -;; #define GSL_SET_REAL(zp,x) do {(zp)->dat[0]=(x);} while(0) -;; #define GSL_SET_IMAG(zp,y) do {(zp)->dat[1]=(y);} while(0) +;; ---------------------------------------------------------------------- -;; #define GSL_SET_COMPLEX_PACKED(zp,n,x,y) do {*((zp)+2*(n))=(x); *((zp)+(2*(n)+1))=(y);} while(0) +(defun-foreign "gsl_poly_dd_taylor" + ((c double-ptr) + (xp :double) + (dd double-ptr) + (xa double-ptr) + (size :unsigned-long) + (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))))

1 0

[cl-gsl-cvs] CVS update: cl-gsl/ChangeLog
by edenny＠common-lisp.net 09 Mar '05

09 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv25684 Modified Files: ChangeLog Log Message: *** empty log message *** Date: Wed Mar 9 04:11:50 2005 Author: edenny Index: cl-gsl/ChangeLog diff -u cl-gsl/ChangeLog:1.4 cl-gsl/ChangeLog:1.5 --- cl-gsl/ChangeLog:1.4 Tue Mar 8 04:35:58 2005 +++ cl-gsl/ChangeLog Wed Mar 9 04:11:50 2005 @@ -1,3 +1,7 @@ +2005-03-09 Edgar Denny <edgardenny(a)comcast.net> + + * test-sf.lisp: Additional unit tests. + 2005-03-08 Edgar Denny <edgardenny(a)comcast.net> * test/test-sf.lisp: More unit tests added.

1 0