[cl-gsl-cvs] CVS update: cl-gsl/vector.lisp
cl-gsl-cvs at common-lisp.net
cl-gsl-cvs at common-lisp.net
Thu Apr 7 02:37:14 UTC 2005
Update of /project/cl-gsl/cvsroot/cl-gsl
In directory common-lisp.net:/tmp/cvs-serv2175
Modified Files:
vector.lisp
Log Message:
Fixes as a result of unit tests.
Date: Thu Apr 7 04:37:14 2005
Author: edenny
Index: cl-gsl/vector.lisp
diff -u cl-gsl/vector.lisp:1.5 cl-gsl/vector.lisp:1.6
--- cl-gsl/vector.lisp:1.5 Mon Apr 4 02:47:39 2005
+++ cl-gsl/vector.lisp Thu Apr 7 04:37:13 2005
@@ -332,6 +332,7 @@
(error "No matching type"))))
+;; TODO: make a (setf (get-element v i) x) version.
(defun set-element (v i x)
(assert (eq 'gsl-vec (type-of v)))
(assert (typep x (gsl-vec-element-type v)))
@@ -351,7 +352,8 @@
(with-complex-double-float->gsl-complex-ptr (c-ptr x)
(wrap-gsl-vector-complex-set (gsl-vec-ptr v) i c-ptr)))
(t
- (error "No matching type"))))
+ (error "No matching type")))
+ v)
(defun set-all (v x)
@@ -371,7 +373,8 @@
(with-complex-double-float->gsl-complex-ptr (c-ptr x)
(wrap-gsl-vector-complex-set-all (gsl-vec-ptr v) c-ptr)))
(t
- (error "No matching type"))))
+ (error "No matching type")))
+ v)
(defun set-zero (v)
@@ -388,7 +391,8 @@
((equal (gsl-vec-element-type v) '(complex (double-float)))
(gsl-vector-complex-set-zero (gsl-vec-ptr v)))
(t
- (error "No matching type"))))
+ (error "No matching type")))
+ v)
(defun set-basis (v i)
@@ -407,11 +411,57 @@
((equal (gsl-vec-element-type v) '(complex (double-float)))
(gsl-vector-complex-set-basis (gsl-vec-ptr v) i))
(t
- (error "No matching type"))))
+ (error "No matching type")))
+ v)
+
+
+(defun read-from-binary-file (v file-name size)
+ (assert (eq 'gsl-vec (type-of v)))
+ (assert (<= size (gsl-vec-size v)))
+ (let ((status))
+ (uffi:with-cstring (c-file-name file-name)
+ (setq status
+ (cond
+ ((eq (gsl-vec-element-type v) 'integer)
+ (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v)))
+ ((eq (gsl-vec-element-type v) 'single-float)
+ (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v)))
+ ((eq (gsl-vec-element-type v) 'double-float)
+ (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v)))
+ ((equal (gsl-vec-element-type v) '(complex (single-float)))
+ (wrap-gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v)))
+ ((equal (gsl-vec-element-type v) '(complex (double-float)))
+ (wrap-gsl-vector-complex-fread c-file-name (gsl-vec-ptr v)))
+ (t
+ (error "No matching type")))))
+ (values v status)))
+
+
+(defun read-from-file (v file-name size)
+ (assert (eq 'gsl-vec (type-of v)))
+ (assert (<= size (gsl-vec-size v)))
+ (let ((status))
+ (uffi:with-cstring (c-file-name file-name)
+ (setq status
+ (cond
+ ((eq (gsl-vec-element-type v) 'integer)
+ (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v)))
+ ((eq (gsl-vec-element-type v) 'single-float)
+ (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v)))
+ ((eq (gsl-vec-element-type v) 'double-float)
+ (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v)))
+ ((equal (gsl-vec-element-type v) '(complex (single-float)))
+ (wrap-gsl-vector-complex-float-fscanf c-file-name
+ (gsl-vec-ptr v)))
+ ((equal (gsl-vec-element-type v) '(complex (double-float)))
+ (wrap-gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v)))
+ (t
+ (error "No matching type")))))
+ (values v status)))
(defun make-vector (size &key (element-type 'double-float) initial-element
- initial-contents)
+ initial-contents from-file from-binary-file)
(assert (typep size 'integer))
(assert (find element-type '(integer single-float double-float
(complex (single-float))
@@ -419,8 +469,8 @@
(let ((v (make-gsl-vec :size size :element-type element-type)))
(setf (gsl-vec-ptr v) (alloc v))
(cond
- ((and initial-element initial-contents)
- (error "cannot define both initial-element and initial-contents keys"))
+ ((and initial-element initial-contents from-file from-binary-file)
+ (error "can only define one of the keys: initial-element, initial-contents, from-file, from-binary-file."))
(initial-element
(gsl-vector:set-all v initial-element))
(initial-contents
@@ -435,18 +485,25 @@
((= i size))
(gsl-vector:set-element v i (aref initial-contents i))))
(t
- (error "initial-contents must be either a list or a vector.")))))
+ (error "initial-contents must be either a list or a vector."))))
+ (from-file
+ (read-from-file v from-file size))
+ (from-binary-file
+ (read-from-binary-file v from-binary-file size)))
v))
-(defmacro with-vector ((vec size &key element-type initial-element
- initial-contents) &body body)
+(defmacro with-vector
+ ((vec size &key element-type initial-element initial-contents from-file
+ from-binary-file) &body body)
`(let ((,vec (make-vector ,size
:element-type (or ,element-type 'double-float)
:initial-element ,initial-element
- :initial-contents ,initial-contents)))
+ :initial-contents ,initial-contents
+ :from-file ,from-file
+ :from-binary-file ,from-binary-file)))
(unwind-protect
- , at body
+ (progn , at body)
(free ,vec))))
@@ -495,49 +552,6 @@
status))
-(defun read-from-binary-file (file-name size element-type)
- (let ((v (make-vector size :element-type element-type))
- (status))
- (uffi:with-cstring (c-file-name file-name)
- (setq status
- (cond
- ((eq (gsl-vec-element-type v) 'integer)
- (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v)))
- ((eq (gsl-vec-element-type v) 'single-float)
- (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v)))
- ((eq (gsl-vec-element-type v) 'double-float)
- (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v)))
- ((equal (gsl-vec-element-type v) '(complex (single-float)))
- (wrap-gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v)))
- ((equal (gsl-vec-element-type v) '(complex (double-float)))
- (wrap-gsl-vector-complex-fread c-file-name (gsl-vec-ptr v)))
- (t
- (error "No matching type")))))
- (values v status)))
-
-
-(defun read-from-file (file-name size element-type)
- (let ((v (make-vector size :element-type element-type))
- (status))
- (uffi:with-cstring (c-file-name file-name)
- (setq status
- (cond
- ((eq (gsl-vec-element-type v) 'integer)
- (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v)))
- ((eq (gsl-vec-element-type v) 'single-float)
- (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v)))
- ((eq (gsl-vec-element-type v) 'double-float)
- (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v)))
- ((equal (gsl-vec-element-type v) '(complex (single-float)))
- (wrap-gsl-vector-complex-float-fscanf c-file-name
- (gsl-vec-ptr v)))
- ((equal (gsl-vec-element-type v) '(complex (double-float)))
- (wrap-gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v)))
- (t
- (error "No matching type")))))
- (values v status)))
-
-
(defun subvector (v offset n)
(assert (eq 'gsl-vec (type-of v)))
(assert (typep offset 'integer))
@@ -891,6 +905,13 @@
(gsl-vector-complex-isnull (gsl-vec-ptr v)))
(t
(error "No matching type")))))
+
+
+(defun gsl-vector->lisp-vector (v)
+ (assert (eq 'gsl-vec (type-of v)))
+ (let ((a (make-array (gsl-vec-size v) :element-type (gsl-vec-element-type v))))
+ (dotimes (i (gsl-vec-size v) a)
+ (setf (aref a i) (get-element v i)))))
;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v)
;; Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex *v)
More information about the Cl-gsl-cvs
mailing list