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 - ,@body + (progn ,@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)