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 05 Mar '05

05 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv27657 Modified Files: vector.lisp Log Message: Fixes for complex vectors. Date: Sat Mar 5 05:31:41 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.2 cl-gsl/vector.lisp:1.3 --- cl-gsl/vector.lisp:1.2 Fri Mar 4 02:56:03 2005 +++ cl-gsl/vector.lisp Sat Mar 5 05:31:41 2005 @@ -40,12 +40,12 @@ (setq type-val :int) (setq type-val-ptr '(* :int)) (setq type-string "vector_int")) - ((eq typ 'complex-double-float) + ((equal typ '(complex (double-float))) (setq type-ptr 'gsl-vector-complex-ptr) (setq type-val 'gsl-complex) (setq type-val-ptr '(* gsl-complex)) (setq type-string "vector_complex")) - ((eq typ 'complex-single-float) + ((equal typ '(complex (single-float))) (setq type-ptr 'gsl-vector-complex-float-ptr) (setq type-val 'gsl-complex-float) (setq type-val-ptr '(* gsl-complex-float)) @@ -107,83 +107,83 @@ ((v1 ,type-ptr)) :int) - ,(unless (or (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(unless (or (equal typ '(complex (double-float))) + (equal typ '(complex (single-float)))) `(defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") ((vec ,type-ptr) (x ,type-val)) :int)) - ,(unless (or (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(unless (or (equal typ '(complex (double-float))) + (equal typ '(complex (single-float)))) `(defun-foreign ,(concatenate 'string "gsl_" type-string "_add_constant") ((vec ,type-ptr) (x ,type-val)) :int)) - ,(unless (or (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(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 (eq typ 'complex-double-float) - (eq typ 'complex-single-float)) + ,(unless (or (equal typ '(complex (double-float))) + (equal typ '(complex (single-float)))) `(defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax_index") ((vec ,type-ptr) @@ -234,8 +234,8 @@ (def-vector-type-funcs% double-float) (def-vector-type-funcs% single-float) (def-vector-type-funcs% integer) -(def-vector-type-funcs% complex-double-float) -(def-vector-type-funcs% complex-single-float) +(def-vector-type-funcs% (complex (double-float))) +(def-vector-type-funcs% (complex (single-float))) (defstruct gsl-vec ;; TODO: print-function ? @@ -244,134 +244,146 @@ element-type) (defun alloc (v) - (assert (eq 'gsl (type-of v))) - (ecase (gsl-vec-element-type v) - ('integer + (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)))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (setf (gsl-vec-ptr v) (gsl-vector-float-alloc (gsl-vec-size v)))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (setf (gsl-vec-ptr v) (gsl-vector-alloc (gsl-vec-size v)))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (setf (gsl-vec-ptr v) (gsl-vector-complex-float-alloc (gsl-vec-size v)))) - ('complex-double-float - (setf (gsl-vec-ptr v) (gsl-vector-complex-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 (type-of v))) - (ecase (gsl-vec-element-type v) - ('integer + (assert (eq 'gsl-vec (type-of v))) + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-free (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-free (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-free (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-vector-complex-float-free (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-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 (type-of v))) + (assert (eq 'gsl-vec (type-of v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-get (gsl-vec-ptr v) i)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-get (gsl-vec-ptr v) i)) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-get (gsl-vec-ptr v) i)) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-complex-float->complex (gsl-vector-complex-float-get (gsl-vec-ptr v) i))) - ('complex-double-float - (gsl-complex->complex (gsl-vector-complex-get (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))) + (t + (error "No matching type")))) (defun set-element (v i x) - (assert (eq 'gsl (type-of v))) - (assert (eq (type-of x) (gsl-vec-element-type v))) + (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))) - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-set (gsl-vec-ptr v) i x)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-set (gsl-vec-ptr v) i x)) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-set (gsl-vec-ptr v) i x)) - ('complex-single-float - (gsl-vector-complex-float-set (gsl-vec-ptr v) - i + ((equal (gsl-vec-element-type v) '(complex (single-float))) + (gsl-vector-complex-float-set (gsl-vec-ptr v) i (complex->gsl-complex-float x))) - ('complex-double-float - (gsl-vector-complex-set (gsl-vec-ptr v) - i - (complex->gsl-complex x))))) + ((equal (gsl-vec-element-type v) '(complex (double-float))) + (gsl-vector-complex-set (gsl-vec-ptr v) i (complex->gsl-complex x))) + (t + (error "No matching type")))) (defun set-all (v x) - (assert (eq 'gsl (type-of v))) - (assert (eq (type-of x) (gsl-vec-element-type v))) - (ecase (gsl-vec-element-type v) - ('integer + (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)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-set-all (gsl-vec-ptr v) x)) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-set-all (gsl-vec-ptr v) x)) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-vector-complex-float-set-all (gsl-vec-ptr v) (complex->gsl-complex-float x))) - ('complex-double-float - (gsl-vector-complex-set-all (gsl-vec-ptr v) - (complex->gsl-complex x))))) + ((equal (gsl-vec-element-type v) '(complex (double-float))) + (gsl-vector-complex-set-all (gsl-vec-ptr v) (complex->gsl-complex x))) + (t + (error "No matching type")))) + (defun set-zero (v) - (assert (eq 'gsl (type-of v))) - (ecase (gsl-vec-element-type v) - ('integer + (assert (eq 'gsl-vec (type-of v))) + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-set-zero (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-set-zero (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-set-zero (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-vector-complex-float-set-zero (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-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")))) (defun set-basis (v i) - (assert (eq 'gsl (type-of v))) + (assert (eq 'gsl-vec (type-of v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-set-basis (gsl-vec-ptr v) i)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-set-basis (gsl-vec-ptr v) i)) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-set-basis (gsl-vec-ptr v) i)) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-vector-complex-float-set-basis (gsl-vec-ptr v) (complex->gsl-complex-float i))) - ('complex-double-float + ((equal (gsl-vec-element-type v) '(complex (double-float))) (gsl-vector-complex-set-basis (gsl-vec-ptr v) - (complex->gsl-complex i))))) + (complex->gsl-complex i))) + (t + (error "No matching type")))) (defun make-vector (size &key (element-type 'double-float) initial-element initial-contents) (assert (typep size 'integer)) (assert (find element-type '(integer single-float double-float - complex-single-float double-single-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)) (cond @@ -396,42 +408,47 @@ (defun write-to-binary-file (file-name v) - (assert (eq 'gsl (type-of 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 - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (wrap-gsl-vector-int-fwrite c-file-name (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (wrap-gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (wrap-gsl-vector-fwrite c-file-name (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (wrap-gsl-vector-complex-float-fwrite c-file-name (gsl-vec-ptr v))) - ('complex-double-float - (wrap-gsl-vector-complex-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 (type-of v))) + (assert (eq 'gsl-vec (type-of v))) (let ((status)) (uffi:with-cstring (c-file-name file-name) (setq status - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (wrap-gsl-vector-int-fprintf c-file-name (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (wrap-gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (wrap-gsl-vector-fprintf c-file-name (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (wrap-gsl-vector-complex-float-fprintf c-file-name (gsl-vec-ptr v))) - ('complex-double-float - (wrap-gsl-vector-complex-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)) @@ -440,17 +457,19 @@ (status)) (uffi:with-cstring (c-file-name file-name) (setq status - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (wrap-gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v))) - ('complex-double-float - (wrap-gsl-vector-complex-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))) @@ -459,23 +478,25 @@ (status)) (uffi:with-cstring (c-file-name file-name) (setq status - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (wrap-gsl-vector-complex-float-fscanf c-file-name (gsl-vec-ptr v))) - ('complex-double-float - (wrap-gsl-vector-complex-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 (type-of v))) + (assert (eq 'gsl-vec (type-of v))) (assert (typep offset 'integer)) (assert (typep n 'integer)) (assert (< (+ offset n) (gsl-vec-size v))) @@ -483,22 +504,24 @@ ;; 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) - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (wrap-gsl-vector-int-subvector (gsl-vec-ptr v) offset n)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (wrap-gsl-vector-float-subvector (gsl-vec-ptr v) offset n)) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (wrap-gsl-vector-subvector (gsl-vec-ptr v) offset n)) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (wrap-gsl-vector-complex-float-subvector (gsl-vec-ptr v) offset n)) - ('complex-double-float - (wrap-gsl-vector-complex-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 (type-of v))) + (assert (eq 'gsl-vec (type-of v))) (assert (typep offset 'integer)) (assert (typep stride 'integer)) (assert (typep n 'integer)) @@ -507,250 +530,287 @@ ;; 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) - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (wrap-gsl-vector-int-subvector-with-stride (gsl-vec-ptr v) offset stride n)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (wrap-gsl-vector-float-subvector-with-stride (gsl-vec-ptr v) offset stride n)) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (wrap-gsl-vector-subvector-with-stride (gsl-vec-ptr v) offset stride n)) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (wrap-gsl-vector-complex-float-subvector-with-stride (gsl-vec-ptr v) offset stride n)) - ('complex-double-float + ((equal (gsl-vec-element-type v) '(complex (double-float))) (wrap-gsl-vector-complex-subvector-with-stride (gsl-vec-ptr v) - offset stride n)))) + 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 (ecase (gsl-vec-element-type v-src) - ('integer + (status (cond + ((eq (gsl-vec-element-type v-src) 'integer) (gsl-vector-int-memcpy (gsl-vec-ptr v-dest) (gsl-vec-ptr v-src))) - ('single-float + ((eq (gsl-vec-element-type v-src) 'single-float) (gsl-vector-float-memcpy (gsl-vec-ptr v-dest) (gsl-vec-ptr v-src))) - ('double-float + ((eq (gsl-vec-element-type v-src) 'double-float) (gsl-vector-memcpy (gsl-vec-ptr v-dest) (gsl-vec-ptr v-src))) - ('complex-single-float + ((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))) - ('complex-double-float + ((equal (gsl-vec-element-type v-src) + '(complex (double-float))) (gsl-vector-complex-memcpy (gsl-vec-ptr v-dest) - (gsl-vec-ptr v-src)))))) + (gsl-vec-ptr v-src))) + (t + (error "No matching type"))))) (values v-dest status))) (defun swap (va vb) - (assert (eq 'gsl (type-of va))) - (assert (eq 'gsl (type-of 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 - (ecase (gsl-vec-element-type va) - ('integer + (cond + ((eq (gsl-vec-element-type va) 'integer) (gsl-vector-int-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('single-float + ((eq (gsl-vec-element-type va) 'single-float) (gsl-vector-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('double-float + ((eq (gsl-vec-element-type va) 'double-float) (gsl-vector-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float + ((equal (gsl-vec-element-type va) '(complex (single-float))) (gsl-vector-complex-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) - (values va status))) + ((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 (type-of v))) + (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 - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-swap-elements (gsl-vec-ptr v) i j)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-swap-elements (gsl-vec-ptr v) i j)) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-swap-elements (gsl-vec-ptr v) i j)) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-vector-complex-float-swap-elements (gsl-vec-ptr v) i j)) - ('complex-double-float - (gsl-vector-complex-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 (type-of v))) + (assert (eq 'gsl-vec (type-of v))) (let ((status - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-reverse (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-reverse (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-reverse (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-vector-complex-float-reverse (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-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 (type-of va))) - (assert (eq 'gsl (type-of 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 - (ecase (gsl-vec-element-type va) - ('integer + (cond + ((eq (gsl-vec-element-type va) 'integer) (gsl-vector-int-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('single-float + ((eq (gsl-vec-element-type va) 'single-float) (gsl-vector-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('double-float - (gsl-vector-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 (type-of va))) - (assert (eq 'gsl (type-of 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 - (ecase (gsl-vec-element-type va) - ('integer + (cond + ((eq (gsl-vec-element-type va) 'integer) (gsl-vector-int-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('single-float + ((eq (gsl-vec-element-type va) 'single-float) (gsl-vector-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('double-float - (gsl-vector-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 (type-of va))) - (assert (eq 'gsl (type-of 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 - (ecase (gsl-vec-element-type va) - ('integer + (cond + ((eq (gsl-vec-element-type va) 'integer) (gsl-vector-int-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('single-float + ((eq (gsl-vec-element-type va) 'single-float) (gsl-vector-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('double-float - (gsl-vector-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 (type-of va))) - (assert (eq 'gsl (type-of 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 - (ecase (gsl-vec-element-type va) - ('integer + (cond + ((eq (gsl-vec-element-type va) 'integer) (gsl-vector-int-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('single-float + ((eq (gsl-vec-element-type va) 'single-float) (gsl-vector-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('double-float - (gsl-vector-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 (type-of v))) - (assert (eq (gsl-vec-element-type v) (type-of x))) + (assert (eq 'gsl-vec (type-of v))) + (assert (typep x (gsl-vec-element-type v))) (let ((status - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-scale (gsl-vec-ptr v) x)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-scale (gsl-vec-ptr v) x)) - ('double-float - (gsl-vector-scale (gsl-vec-ptr v) x))))) + ((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 (type-of v))) - (assert (eq (gsl-vec-element-type v) (type-of x))) + (assert (eq 'gsl-vec (type-of v))) + (assert (typep x (gsl-vec-element-type v))) (let ((status - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-add-constant (gsl-vec-ptr v) x)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-add-constant (gsl-vec-ptr v) x)) - ('double-float - (gsl-vector-add-constant (gsl-vec-ptr v) x))))) + ((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 (type-of v))) - (ecase (gsl-vec-element-type v) - ('integer + (assert (eq 'gsl-vec (type-of v))) + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-max (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-max (gsl-vec-ptr v))) - ('double-float - (gsl-vector-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 (type-of v))) - (ecase (gsl-vec-element-type v) - ('integer + (assert (eq 'gsl-vec (type-of v))) + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-min (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-min (gsl-vec-ptr v))) - ('double-float - (gsl-vector-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 (type-of v))) - (ecase (gsl-vec-element-type v) - ('integer + (assert (eq 'gsl-vec (type-of v))) + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-max-index (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-max-index (gsl-vec-ptr v))) - ('double-float - (gsl-vector-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 (type-of v))) - (ecase (gsl-vec-element-type v) - ('integer + (assert (eq 'gsl-vec (type-of v))) + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-min-index (gsl-vec-ptr v))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-min-index (gsl-vec-ptr v))) - ('double-float - (gsl-vector-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 (type-of 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))) - (ecase (gsl-vec-element-type v) - ('integer + (cond + ((eq (gsl-vec-element-type v) 'integer) (gsl-vector-int-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) - ('double-float - (gsl-vector-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)) @@ -759,7 +819,7 @@ (defun min-max-values (v) - (assert (eq 'gsl (type-of v))) + (assert (eq 'gsl-vec (type-of v))) (destructuring-bind (min-index max-index) (min-max-indicies v) (list (get-element v min-index) @@ -767,18 +827,20 @@ (defun isnull (v) - (assert (eq 'gsl (type-of v))) - (1/0->t/nil (ecase (gsl-vec-element-type v) - ('integer + (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))) - ('single-float + ((eq (gsl-vec-element-type v) 'single-float) (gsl-vector-float-isnull (gsl-vec-ptr v))) - ('double-float + ((eq (gsl-vec-element-type v) 'double-float) (gsl-vector-isnull (gsl-vec-ptr v))) - ('complex-single-float + ((equal (gsl-vec-element-type v) '(complex (single-float))) (gsl-vector-complex-float-isnull (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-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"))))) ;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v) ;; Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex *v)

1 0

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

04 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl/c In directory common-lisp.net:/tmp/cvs-serv380 Modified Files: cwrapperstub.c Log Message: Add needed wrappers for vector.lisp. Date: Fri Mar 4 02:58:58 2005 Author: edenny Index: cl-gsl/c/cwrapperstub.c diff -u cl-gsl/c/cwrapperstub.c:1.1.1.1 cl-gsl/c/cwrapperstub.c:1.2 --- cl-gsl/c/cwrapperstub.c:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/c/cwrapperstub.c Fri Mar 4 02:58:57 2005 @@ -388,32 +388,40 @@ gsl_vector *wrap_gsl_vector_subvector(gsl_vector *v, size_t offset, size_t n) { + gsl_vector *ret; gsl_vector_view v_view = gsl_vector_subvector(v, offset, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_float *wrap_gsl_vector_float_subvector(gsl_vector_float *v, size_t offset, size_t n) { + gsl_vector_float *ret; gsl_vector_float_view v_view = gsl_vector_float_subvector(v, offset, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_int *wrap_gsl_vector_int_subvector(gsl_vector_int *v, size_t offset, size_t n) { + gsl_vector_int *ret; gsl_vector_int_view v_view = gsl_vector_int_subvector(v, offset, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_complex *wrap_gsl_vector_complex_subvector(gsl_vector_complex *v, size_t offset, size_t n) { + gsl_vector_complex *ret; gsl_vector_complex_view v_view = gsl_vector_complex_subvector(v, offset, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_complex_float *wrap_gsl_vector_complex_float_subvector( @@ -421,9 +429,11 @@ size_t offset, size_t n) { + gsl_vector_complex_float *ret; gsl_vector_complex_float_view v_view = gsl_vector_complex_float_subvector(v, offset, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } /* ----------------------------------------------------------------- */ @@ -434,9 +444,11 @@ size_t stride, size_t n) { + gsl_vector *ret; gsl_vector_view v_view = gsl_vector_subvector_with_stride(v, offset, stride, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_float *wrap_gsl_vector_float_subvector_with_stride( @@ -445,9 +457,11 @@ size_t stride, size_t n) { + gsl_vector_float *ret; gsl_vector_float_view v_view = gsl_vector_float_subvector_with_stride(v, offset, stride, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_int *wrap_gsl_vector_int_subvector_with_stride( @@ -456,9 +470,11 @@ size_t stride, size_t n) { + gsl_vector_int *ret; gsl_vector_int_view v_view = gsl_vector_int_subvector_with_stride(v, offset, stride, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_complex *wrap_gsl_vector_complex_subvector_with_stride( @@ -467,9 +483,11 @@ size_t stride, size_t n) { + gsl_vector_complex *ret; gsl_vector_complex_view v_view = gsl_vector_complex_subvector_with_stride(v, offset, stride, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; } gsl_vector_complex_float *wrap_gsl_vector_complex_float_subvector_with_stride( @@ -478,7 +496,9 @@ size_t stride, size_t n) { + gsl_vector_complex_float *ret; gsl_vector_complex_float_view v_view = gsl_vector_complex_float_subvector_with_stride(v, offset, stride, n); - return &v_view.vector; + ret = &v_view.vector; + return ret; }

1 0

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

04 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv359 Added Files: ChangeLog Log Message: *** empty log message *** Date: Fri Mar 4 02:57:02 2005 Author: edenny

1 0

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

04 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv328 Modified Files: vector.lisp Log Message: Make file actually compile. Date: Fri Mar 4 02:56:04 2005 Author: edenny Index: cl-gsl/vector.lisp diff -u cl-gsl/vector.lisp:1.1.1.1 cl-gsl/vector.lisp:1.2 --- cl-gsl/vector.lisp:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/vector.lisp Fri Mar 4 02:56:03 2005 @@ -107,63 +107,89 @@ ((v1 ,type-ptr)) :int) - (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) - (x ,type-val)) - :int) - - (defun-foreign ,(concatenate 'string "gsl_" type-string "_add_constant") - ((vec ,type-ptr) - (x ,type-val)) - :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) + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_add") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_sub") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_mul") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_div") + ((va ,type-ptr) + (vb ,type-ptr)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_scale") + ((vec ,type-ptr) + (x ,type-val)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string + "gsl_" type-string "_add_constant") + ((vec ,type-ptr) + (x ,type-val)) + :int)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max") + ((vec ,type-ptr)) + ,type-val)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min") + ((vec ,type-ptr)) + ,type-val)) + + ,(unless (or (eq typ 'complex-double-float) + (eq 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 (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index") + ((vec ,type-ptr)) + size-t)) + + ,(unless (or (eq typ 'complex-double-float) + (eq typ 'complex-single-float)) + `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index") + ((vec ,type-ptr)) + size-t)) + + ,(unless (or (eq typ 'complex-double-float) + (eq 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)) @@ -218,7 +244,7 @@ element-type) (defun alloc (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (setf (gsl-vec-ptr v) (gsl-vector-int-alloc (gsl-vec-size v)))) @@ -233,7 +259,7 @@ (defun free (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-free (gsl-vec-ptr v))) @@ -251,7 +277,7 @@ (defun get-element (v i) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) (ecase (gsl-vec-element-type v) @@ -269,7 +295,7 @@ (defun set-element (v i x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (type-of x) (gsl-vec-element-type v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) @@ -291,7 +317,7 @@ (defun set-all (v x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (type-of x) (gsl-vec-element-type v))) (ecase (gsl-vec-element-type v) ('integer @@ -308,7 +334,7 @@ (complex->gsl-complex x))))) (defun set-zero (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-set-zero (gsl-vec-ptr v))) @@ -317,15 +343,13 @@ ('double-float (gsl-vector-set-zero (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-set-zero (gsl-vec-ptr v) - (complex->gsl-complex-float))) + (gsl-vector-complex-float-set-zero (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-set-zero (gsl-vec-ptr v) - (complex->gsl-complex))))) + (gsl-vector-complex-set-zero (gsl-vec-ptr v))))) (defun set-basis (v i) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (typep i 'integer)) (assert (< i (gsl-vec-size v))) (ecase (gsl-vec-element-type v) @@ -349,7 +373,7 @@ (assert (find element-type '(integer single-float double-float complex-single-float double-single-float))) (let ((v (make-gsl-vec :size size :element-type element-type))) - (setf (gsl-vec-ptr v) (gsl-vector:alloc v)) + (setf (gsl-vec-ptr v) (alloc v)) (cond ((and initial-element initial-contents) (error "cannot define both initial-element and initial-contents keys")) @@ -372,83 +396,86 @@ (defun write-to-binary-file (file-name v) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (let ((status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fwrite c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fwrite c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fwrite c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fwrite c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fwrite c-file-name + (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v)))))) status)) (defun write-to-file (file-name v) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (let ((status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fprintf c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fprintf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fprintf c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fprintf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fprintf c-file-name + (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v)))))) status)) (defun read-from-binary-file (file-name size element-type) - (let ((v (make-vector :size size :element-type element-type)) + (let ((v (make-vector size :element-type element-type)) (status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fread c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fread c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fread c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fread c-file-name (gsl-vec-ptr v)))))) (values v status))) (defun read-from-file (file-name size element-type) - (let ((v (make-vector :size size :element-type element-type)) + (let ((v (make-vector size :element-type element-type)) (status)) - (with-cstring (c-file-name file-name) + (uffi:with-cstring (c-file-name file-name) (setq status (ecase (gsl-vec-element-type v) ('integer (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v))) ('single-float - (gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v))) ('double-float - (gsl-vector-fscanf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v))) ('complex-single-float - (gsl-vector-complex-float-fscanf c-file-name (gsl-vec-ptr v))) + (wrap-gsl-vector-complex-float-fscanf c-file-name + (gsl-vec-ptr v))) ('complex-double-float - (gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v)))))) + (wrap-gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v)))))) (values v status))) (defun subvector (v offset n) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (assert (typep offset 'integer)) (assert (typep n 'integer)) (assert (< (+ offset n) (gsl-vec-size v))) @@ -471,7 +498,7 @@ (defun subvector-with-stride (v offset stride n) - (declare (gsl-vector v)) + (assert (eq 'gsl (type-of v))) (assert (typep offset 'integer)) (assert (typep stride 'integer)) (assert (typep n 'integer)) @@ -500,8 +527,8 @@ (defun copy (v-src) - (let* ((v-dest (make-vector :size (gsl-vec-size v-src) - :element-type (gsl-vec-element-type v-src))) + (let* ((v-dest (make-vector (gsl-vec-size v-src) + :element-type (gsl-vec-element-type v-src))) (status (ecase (gsl-vec-element-type v-src) ('integer (gsl-vector-int-memcpy (gsl-vec-ptr v-dest) @@ -522,7 +549,8 @@ (defun swap (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (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 @@ -541,7 +569,7 @@ (defun swap-elements (v i j) - (declare (gsl-vec v) (integer i) (integer j)) + (assert (eq 'gsl (type-of v))) (assert (typep i 'integer)) (assert (typep j 'integer)) (assert (< i (gsl-vec-size v))) @@ -562,7 +590,7 @@ (defun reverse-vector (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (let ((status (ecase (gsl-vec-element-type v) ('integer @@ -579,7 +607,8 @@ (defun add (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (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 @@ -589,16 +618,13 @@ ('single-float (gsl-vector-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status))) (defun sub (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (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 @@ -608,15 +634,12 @@ ('single-float (gsl-vector-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status))) (defun mul (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (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 @@ -626,16 +649,13 @@ ('single-float (gsl-vector-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status))) (defun div (va vb) - (declare (gsl-vec va) (gsl-vec vb)) + (assert (eq 'gsl (type-of va))) + (assert (eq 'gsl (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 @@ -645,16 +665,12 @@ ('single-float (gsl-vector-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) ('double-float - (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-single-float - (gsl-vector-complex-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb))) - ('complex-double-float - (gsl-vector-complex-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) + (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))))) (values va status))) (defun scale (v x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (gsl-vec-element-type v) (type-of x))) (let ((status (ecase (gsl-vec-element-type v) @@ -663,16 +679,12 @@ ('single-float (gsl-vector-float-scale (gsl-vec-ptr v) x)) ('double-float - (gsl-vector-scale (gsl-vec-ptr v) x)) - ('complex-single-float - (gsl-vector-complex-float-scale (gsl-vec-ptr v) x)) - ('complex-double-float - (gsl-vector-complex-scale (gsl-vec-ptr v) x))))) + (gsl-vector-scale (gsl-vec-ptr v) x))))) (values v status))) (defun add-constant (v x) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (assert (eq (gsl-vec-element-type v) (type-of x))) (let ((status (ecase (gsl-vec-element-type v) @@ -681,98 +693,73 @@ ('single-float (gsl-vector-float-add-constant (gsl-vec-ptr v) x)) ('double-float - (gsl-vector-add-constant (gsl-vec-ptr v) x)) - ('complex-single-float - (gsl-vector-complex-float-add-constant (gsl-vec-ptr v) x)) - ('complex-double-float - (gsl-vector-complex-add-constant (gsl-vec-ptr v) x))))) + (gsl-vector-add-constant (gsl-vec-ptr v) x))))) (values v status))) (defun max-value (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-max (gsl-vec-ptr v))) ('single-float (gsl-vector-float-max (gsl-vec-ptr v))) ('double-float - (gsl-vector-max (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-max (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-max (gsl-vec-ptr v))))) + (gsl-vector-max (gsl-vec-ptr v))))) (defun min-value (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-min (gsl-vec-ptr v))) ('single-float (gsl-vector-float-min (gsl-vec-ptr v))) ('double-float - (gsl-vector-min (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-min (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-min (gsl-vec-ptr v))))) + (gsl-vector-min (gsl-vec-ptr v))))) (defun max-index (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-max-index (gsl-vec-ptr v))) ('single-float (gsl-vector-float-max-index (gsl-vec-ptr v))) ('double-float - (gsl-vector-max-index (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-max-index (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-max-index (gsl-vec-ptr v))))) + (gsl-vector-max-index (gsl-vec-ptr v))))) -(defun max-index (v) - (declare (gsl-vec v)) +(defun min-index (v) + (assert (eq 'gsl (type-of v))) (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-min-index (gsl-vec-ptr v))) ('single-float (gsl-vector-float-min-index (gsl-vec-ptr v))) ('double-float - (gsl-vector-min-index (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-min-index (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-min-index (gsl-vec-ptr v))))) - + (gsl-vector-min-index (gsl-vec-ptr v))))) (defun min-max-indicies (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (let ((min-ptr (uffi:allocate-foreign-object 'size-t)) (max-ptr (uffi:allocate-foreign-object 'size-t))) (ecase (gsl-vec-element-type v) ('integer - (gsl-vector-int-minmax-index (gsl-vec-ptr v))) + (gsl-vector-int-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) ('single-float - (gsl-vector-float-minmax-index (gsl-vec-ptr v))) + (gsl-vector-float-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)) ('double-float - (gsl-vector-minmax-index (gsl-vec-ptr v))) - ('complex-single-float - (gsl-vector-complex-float-minmax-index (gsl-vec-ptr v))) - ('complex-double-float - (gsl-vector-complex-minmax-index (gsl-vec-ptr v)))) + (gsl-vector-minmax-index (gsl-vec-ptr v) min-ptr max-ptr))) (prog1 - (list (uffi:deref-pointer 'size-t min-ptr) - (uffi:deref-pointer 'size-t max-ptr)) + (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) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (destructuring-bind (min-index max-index) (min-max-indicies v) (list (get-element v min-index) @@ -780,7 +767,7 @@ (defun isnull (v) - (declare (gsl-vec v)) + (assert (eq 'gsl (type-of v))) (1/0->t/nil (ecase (gsl-vec-element-type v) ('integer (gsl-vector-int-isnull (gsl-vec-ptr v)))

1 0

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

04 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv308 Modified Files: package.lisp Log Message: Add exported symbols to package cl-gsl-vector. Date: Fri Mar 4 02:55:10 2005 Author: edenny Index: cl-gsl/package.lisp diff -u cl-gsl/package.lisp:1.1.1.1 cl-gsl/package.lisp:1.2 --- cl-gsl/package.lisp:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/package.lisp Fri Mar 4 02:55:10 2005 @@ -37,10 +37,12 @@ #:define-foreign-type #:def-foreign-struct #:gsl-complex->complex + #:gsl-complex-float->complex #:lisp-vec->c-array #:complex-packed-array->lisp-vec + #:complex->gsl-complex + #:complex->gsl-complex-float #:c-array->lisp-vec - #:defconstant-export #:register-constants )) @@ -92,10 +94,34 @@ (:nicknames #:gsl-vector) (:use #:cl #:cl-gsl) (:export + #:free #:make-vector #:get-element #:set-element #:set-all #:set-zero #:set-basis + #:write-to-binary-file + #:write-to-file + #:read-from-binary-file + #:read-from-file + #:subvector + #:subvector-with-stride + #:copy + #:swap + #:swap-elements + #:reverse-vector + #:add + #:sub + #:mul + #:div + #:scale + #:add-constant + #:max-value + #:min-value + #:max-index + #:min-index + #:min-max-indicies + #:min-max-values + #:isnull ))

1 0

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

04 Mar '05

Update of /project/cl-gsl/cvsroot/cl-gsl In directory common-lisp.net:/tmp/cvs-serv32738 Modified Files: ffi.lisp Log Message: Add functions needed by vector.lisp. Date: Fri Mar 4 02:52:39 2005 Author: edenny Index: cl-gsl/ffi.lisp diff -u cl-gsl/ffi.lisp:1.1.1.1 cl-gsl/ffi.lisp:1.2 --- cl-gsl/ffi.lisp:1.1.1.1 Wed Mar 2 02:04:53 2005 +++ cl-gsl/ffi.lisp Fri Mar 4 02:52:38 2005 @@ -57,7 +57,7 @@ ;; ---------------------------------------------------------------------- ;; TODO: size_t may not always be unsigned long, could also be unsigned int. -(define-foreign-type (size-t :unsigned-long)) +(define-foreign-type size-t :unsigned-long) (def-foreign-struct gsl-complex (dat (:array :double 2))) @@ -212,16 +212,27 @@ (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 (z) (let* ((z-ptr (uffi:allocate-foreign-object 'gsl-complex)) - (uffi:get-slot-pointer z-ptr 'double-ptr 'cl-gsl::dat)) - )) + (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)) + z-ptr)) +;; FIXME: see above (defun complex->gsl-complex-float (z) - (let ((z-ptr (uffi:allocate-foreign-object 'gsl-complex-float))) - )) + (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)) + z-ptr)) -;; TODO: generalize to all supported types + +;; TODO: generalize to all supported types? (defun lisp-vec->c-array (v) (declare (vector v)) (let* ((len (length v)) @@ -230,7 +241,7 @@ (setf (uffi:deref-array c-ptr :double i) (aref v i))) c-ptr)) -;; TODO: generalize to all supported types +;; TODO: generalize to all supported types? (defun c-array->lisp-vec (c-ptr len) (let ((lisp-vec (make-array len :element-type 'double-float))) (dotimes (i len)

1 0