[cl-gsl-cvs] CVS update: cl-gsl/vector.lisp
Edgar Denny
edenny at common-lisp.net
Sat Mar 5 04:31:44 UTC 2005
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)
More information about the Cl-gsl-cvs
mailing list