/[cl-gsl]/cl-gsl/vector.lisp
ViewVC logotype

Diff of /cl-gsl/vector.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by edenny, Fri Mar 4 01:56:03 2005 UTC revision 1.3 by edenny, Sat Mar 5 04:31:41 2005 UTC
# Line 40  Line 40 
40         (setq type-val :int)         (setq type-val :int)
41         (setq type-val-ptr '(* :int))         (setq type-val-ptr '(* :int))
42         (setq type-string "vector_int"))         (setq type-string "vector_int"))
43        ((eq typ 'complex-double-float)        ((equal typ '(complex (double-float)))
44         (setq type-ptr 'gsl-vector-complex-ptr)         (setq type-ptr 'gsl-vector-complex-ptr)
45         (setq type-val 'gsl-complex)         (setq type-val 'gsl-complex)
46         (setq type-val-ptr '(* gsl-complex))         (setq type-val-ptr '(* gsl-complex))
47         (setq type-string "vector_complex"))         (setq type-string "vector_complex"))
48        ((eq typ 'complex-single-float)        ((equal typ '(complex (single-float)))
49         (setq type-ptr 'gsl-vector-complex-float-ptr)         (setq type-ptr 'gsl-vector-complex-float-ptr)
50         (setq type-val 'gsl-complex-float)         (setq type-val 'gsl-complex-float)
51         (setq type-val-ptr '(* gsl-complex-float))         (setq type-val-ptr '(* gsl-complex-float))
# Line 107  Line 107 
107             ((v1 ,type-ptr))             ((v1 ,type-ptr))
108           :int)           :int)
109    
110         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
111                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
112            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_add")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_add")
113                 ((va ,type-ptr)                 ((va ,type-ptr)
114                  (vb ,type-ptr))                  (vb ,type-ptr))
115               :int))               :int))
116    
117         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
118                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
119            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_sub")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_sub")
120                 ((va ,type-ptr)                 ((va ,type-ptr)
121                  (vb ,type-ptr))                  (vb ,type-ptr))
122               :int))               :int))
123    
124         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
125                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
126            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_mul")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_mul")
127                 ((va ,type-ptr)                 ((va ,type-ptr)
128                  (vb ,type-ptr))                  (vb ,type-ptr))
129               :int))               :int))
130    
131         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
132                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
133            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_div")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_div")
134                 ((va ,type-ptr)                 ((va ,type-ptr)
135                  (vb ,type-ptr))                  (vb ,type-ptr))
136               :int))               :int))
137    
138         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
139                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
140            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_scale")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_scale")
141                 ((vec ,type-ptr)                 ((vec ,type-ptr)
142                  (x ,type-val))                  (x ,type-val))
143               :int))               :int))
144    
145         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
146                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
147            `(defun-foreign ,(concatenate 'string            `(defun-foreign ,(concatenate 'string
148                                          "gsl_" type-string "_add_constant")                                          "gsl_" type-string "_add_constant")
149                 ((vec ,type-ptr)                 ((vec ,type-ptr)
150                  (x ,type-val))                  (x ,type-val))
151               :int))               :int))
152    
153         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
154                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
155            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max")
156                 ((vec ,type-ptr))                 ((vec ,type-ptr))
157               ,type-val))               ,type-val))
158    
159         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
160                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
161            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min")
162                 ((vec ,type-ptr))                 ((vec ,type-ptr))
163               ,type-val))               ,type-val))
164    
165         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
166                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
167            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax")
168                 ((vec ,type-ptr)                 ((vec ,type-ptr)
169                  (min ,type-val-ptr)                  (min ,type-val-ptr)
170                  (max ,type-val-ptr))                  (max ,type-val-ptr))
171               :void))               :void))
172    
173         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
174                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
175            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index")
176                 ((vec ,type-ptr))                 ((vec ,type-ptr))
177               size-t))               size-t))
178    
179         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
180                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
181            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index")            `(defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index")
182                 ((vec ,type-ptr))                 ((vec ,type-ptr))
183               size-t))               size-t))
184    
185         ,(unless (or (eq typ 'complex-double-float)         ,(unless (or (equal typ '(complex (double-float)))
186                      (eq typ 'complex-single-float))                      (equal typ '(complex (single-float))))
187            `(defun-foreign ,(concatenate 'string            `(defun-foreign ,(concatenate 'string
188                                          "gsl_" type-string "_minmax_index")                                          "gsl_" type-string "_minmax_index")
189                 ((vec ,type-ptr)                 ((vec ,type-ptr)
# Line 234  Line 234 
234  (def-vector-type-funcs% double-float)  (def-vector-type-funcs% double-float)
235  (def-vector-type-funcs% single-float)  (def-vector-type-funcs% single-float)
236  (def-vector-type-funcs% integer)  (def-vector-type-funcs% integer)
237  (def-vector-type-funcs% complex-double-float)  (def-vector-type-funcs% (complex (double-float)))
238  (def-vector-type-funcs% complex-single-float)  (def-vector-type-funcs% (complex (single-float)))
239    
240  (defstruct gsl-vec  (defstruct gsl-vec
241    ;; TODO: print-function ?    ;; TODO: print-function ?
# Line 244  Line 244 
244    element-type)    element-type)
245    
246  (defun alloc (v)  (defun alloc (v)
247    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
248    (ecase (gsl-vec-element-type v)    (cond
249      ('integer      ((eq (gsl-vec-element-type v) 'integer)
250       (setf (gsl-vec-ptr v) (gsl-vector-int-alloc (gsl-vec-size v))))       (setf (gsl-vec-ptr v) (gsl-vector-int-alloc (gsl-vec-size v))))
251      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
252       (setf (gsl-vec-ptr v) (gsl-vector-float-alloc (gsl-vec-size v))))       (setf (gsl-vec-ptr v) (gsl-vector-float-alloc (gsl-vec-size v))))
253      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
254       (setf (gsl-vec-ptr v) (gsl-vector-alloc (gsl-vec-size v))))       (setf (gsl-vec-ptr v) (gsl-vector-alloc (gsl-vec-size v))))
255      ('complex-single-float      ((equal (gsl-vec-element-type v) '(complex (single-float)))
256       (setf (gsl-vec-ptr v) (gsl-vector-complex-float-alloc (gsl-vec-size v))))       (setf (gsl-vec-ptr v) (gsl-vector-complex-float-alloc (gsl-vec-size v))))
257      ('complex-double-float      ((equal (gsl-vec-element-type v) '(complex (double-float)))
258       (setf (gsl-vec-ptr v) (gsl-vector-complex-alloc (gsl-vec-size v))))))       (setf (gsl-vec-ptr v) (gsl-vector-complex-alloc (gsl-vec-size v))))
259        (t
260         (error "No matching type"))))
261    
262    
263  (defun free (v)  (defun free (v)
264    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
265    (ecase (gsl-vec-element-type v)    (cond
266      ('integer      ((eq (gsl-vec-element-type v) 'integer)
267       (gsl-vector-int-free (gsl-vec-ptr v)))       (gsl-vector-int-free (gsl-vec-ptr v)))
268      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
269       (gsl-vector-float-free (gsl-vec-ptr v)))       (gsl-vector-float-free (gsl-vec-ptr v)))
270      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
271       (gsl-vector-free (gsl-vec-ptr v)))       (gsl-vector-free (gsl-vec-ptr v)))
272      ('complex-single-float      ((equal (gsl-vec-element-type v) '(complex (single-float)))
273       (gsl-vector-complex-float-free (gsl-vec-ptr v)))       (gsl-vector-complex-float-free (gsl-vec-ptr v)))
274      ('complex-double-float      ((equal (gsl-vec-element-type v) '(complex (double-float)))
275       (gsl-vector-complex-free (gsl-vec-ptr v))))       (gsl-vector-complex-free (gsl-vec-ptr v)))
276        (t
277         (error "No matching type")))
278    (setf (gsl-vec-ptr v) nil)    (setf (gsl-vec-ptr v) nil)
279    (setf (gsl-vec-size v) nil)    (setf (gsl-vec-size v) nil)
280    (setf (gsl-vec-element-type v) nil))    (setf (gsl-vec-element-type v) nil))
281    
282    
283  (defun get-element (v i)  (defun get-element (v i)
284    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
285    (assert (typep i 'integer))    (assert (typep i 'integer))
286    (assert (< i (gsl-vec-size v)))    (assert (< i (gsl-vec-size v)))
287    (ecase (gsl-vec-element-type v)    (cond
288      ('integer      ((eq (gsl-vec-element-type v) 'integer)
289       (gsl-vector-int-get (gsl-vec-ptr v) i))       (gsl-vector-int-get (gsl-vec-ptr v) i))
290      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
291       (gsl-vector-float-get (gsl-vec-ptr v) i))       (gsl-vector-float-get (gsl-vec-ptr v) i))
292      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
293       (gsl-vector-get (gsl-vec-ptr v) i))       (gsl-vector-get (gsl-vec-ptr v) i))
294      ('complex-single-float      ((equal (gsl-vec-element-type v) '(complex (single-float)))
295       (gsl-complex-float->complex (gsl-vector-complex-float-get       (gsl-complex-float->complex (gsl-vector-complex-float-get
296                                    (gsl-vec-ptr v) i)))                                    (gsl-vec-ptr v) i)))
297      ('complex-double-float      ((equal (gsl-vec-element-type v) '(complex (double-float)))
298       (gsl-complex->complex (gsl-vector-complex-get (gsl-vec-ptr v) i)))))       (gsl-complex->complex (gsl-vector-complex-get (gsl-vec-ptr v) i)))
299        (t
300         (error "No matching type"))))
301    
302    
303  (defun set-element (v i x)  (defun set-element (v i x)
304    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
305    (assert (eq (type-of x) (gsl-vec-element-type v)))    (assert (typep x (gsl-vec-element-type v)))
306    (assert (typep i 'integer))    (assert (typep i 'integer))
307    (assert (< i (gsl-vec-size v)))    (assert (< i (gsl-vec-size v)))
308    (ecase (gsl-vec-element-type v)    (cond
309      ('integer      ((eq (gsl-vec-element-type v) 'integer)
310       (gsl-vector-int-set (gsl-vec-ptr v) i x))       (gsl-vector-int-set (gsl-vec-ptr v) i x))
311      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
312       (gsl-vector-float-set (gsl-vec-ptr v) i x))       (gsl-vector-float-set (gsl-vec-ptr v) i x))
313      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
314       (gsl-vector-set (gsl-vec-ptr v) i x))       (gsl-vector-set (gsl-vec-ptr v) i x))
315      ('complex-single-float      ((equal (gsl-vec-element-type v) '(complex (single-float)))
316       (gsl-vector-complex-float-set (gsl-vec-ptr v)       (gsl-vector-complex-float-set (gsl-vec-ptr v) i
                                    i  
317                                     (complex->gsl-complex-float x)))                                     (complex->gsl-complex-float x)))
318      ('complex-double-float      ((equal (gsl-vec-element-type v) '(complex (double-float)))
319       (gsl-vector-complex-set (gsl-vec-ptr v)       (gsl-vector-complex-set (gsl-vec-ptr v) i (complex->gsl-complex x)))
320                               i      (t
321                               (complex->gsl-complex x)))))       (error "No matching type"))))
322    
323    
324  (defun set-all (v x)  (defun set-all (v x)
325    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
326    (assert (eq (type-of x) (gsl-vec-element-type v)))    (assert (typep x (gsl-vec-element-type v)))
327    (ecase (gsl-vec-element-type v)    (cond
328      ('integer      ((eq (gsl-vec-element-type v) 'integer)
329       (gsl-vector-int-set-all (gsl-vec-ptr v) x))       (gsl-vector-int-set-all (gsl-vec-ptr v) x))
330      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
331       (gsl-vector-float-set-all (gsl-vec-ptr v) x))       (gsl-vector-float-set-all (gsl-vec-ptr v) x))
332      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
333       (gsl-vector-set-all (gsl-vec-ptr v) x))       (gsl-vector-set-all (gsl-vec-ptr v) x))
334      ('complex-single-float      ((equal (gsl-vec-element-type v) '(complex (single-float)))
335       (gsl-vector-complex-float-set-all (gsl-vec-ptr v)       (gsl-vector-complex-float-set-all (gsl-vec-ptr v)
336                                         (complex->gsl-complex-float x)))                                         (complex->gsl-complex-float x)))
337      ('complex-double-float      ((equal (gsl-vec-element-type v) '(complex (double-float)))
338       (gsl-vector-complex-set-all (gsl-vec-ptr v)       (gsl-vector-complex-set-all (gsl-vec-ptr v) (complex->gsl-complex x)))
339                                   (complex->gsl-complex x)))))      (t
340         (error "No matching type"))))
341    
342    
343  (defun set-zero (v)  (defun set-zero (v)
344    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
345    (ecase (gsl-vec-element-type v)    (cond
346      ('integer      ((eq (gsl-vec-element-type v) 'integer)
347       (gsl-vector-int-set-zero (gsl-vec-ptr v)))       (gsl-vector-int-set-zero (gsl-vec-ptr v)))
348      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
349       (gsl-vector-float-set-zero (gsl-vec-ptr v)))       (gsl-vector-float-set-zero (gsl-vec-ptr v)))
350      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
351       (gsl-vector-set-zero (gsl-vec-ptr v)))       (gsl-vector-set-zero (gsl-vec-ptr v)))
352      ('complex-single-float      ((equal (gsl-vec-element-type v) '(complex (single-float)))
353       (gsl-vector-complex-float-set-zero (gsl-vec-ptr v)))       (gsl-vector-complex-float-set-zero (gsl-vec-ptr v)))
354      ('complex-double-float      ((equal (gsl-vec-element-type v) '(complex (double-float)))
355       (gsl-vector-complex-set-zero (gsl-vec-ptr v)))))       (gsl-vector-complex-set-zero (gsl-vec-ptr v)))
356        (t
357         (error "No matching type"))))
358    
359    
360  (defun set-basis (v i)  (defun set-basis (v i)
361    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
362    (assert (typep i 'integer))    (assert (typep i 'integer))
363    (assert (< i (gsl-vec-size v)))    (assert (< i (gsl-vec-size v)))
364    (ecase (gsl-vec-element-type v)    (cond
365      ('integer      ((eq (gsl-vec-element-type v) 'integer)
366       (gsl-vector-int-set-basis (gsl-vec-ptr v) i))       (gsl-vector-int-set-basis (gsl-vec-ptr v) i))
367      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
368       (gsl-vector-float-set-basis (gsl-vec-ptr v) i))       (gsl-vector-float-set-basis (gsl-vec-ptr v) i))
369      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
370       (gsl-vector-set-basis (gsl-vec-ptr v) i))       (gsl-vector-set-basis (gsl-vec-ptr v) i))
371      ('complex-single-float      ((equal (gsl-vec-element-type v) '(complex (single-float)))
372       (gsl-vector-complex-float-set-basis (gsl-vec-ptr v)       (gsl-vector-complex-float-set-basis (gsl-vec-ptr v)
373                                           (complex->gsl-complex-float i)))                                           (complex->gsl-complex-float i)))
374      ('complex-double-float      ((equal (gsl-vec-element-type v) '(complex (double-float)))
375       (gsl-vector-complex-set-basis (gsl-vec-ptr v)       (gsl-vector-complex-set-basis (gsl-vec-ptr v)
376                                     (complex->gsl-complex i)))))                                     (complex->gsl-complex i)))
377        (t
378         (error "No matching type"))))
379    
380    
381  (defun make-vector (size &key (element-type 'double-float) initial-element  (defun make-vector (size &key (element-type 'double-float) initial-element
382                      initial-contents)                      initial-contents)
383    (assert (typep size 'integer))    (assert (typep size 'integer))
384    (assert (find element-type '(integer single-float double-float    (assert (find element-type '(integer single-float double-float
385                                 complex-single-float double-single-float)))                                 (complex (single-float))
386                                   (complex (double-float))) :test #'equal))
387    (let ((v (make-gsl-vec :size size :element-type element-type)))    (let ((v (make-gsl-vec :size size :element-type element-type)))
388      (setf (gsl-vec-ptr v) (alloc v))      (setf (gsl-vec-ptr v) (alloc v))
389      (cond      (cond
# Line 396  Line 408 
408    
409    
410  (defun write-to-binary-file (file-name v)  (defun write-to-binary-file (file-name v)
411    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
412    (let ((status))    (let ((status))
413        ;; TODO: check if uffi:with-string returns a result, docs unclear.
414      (uffi:with-cstring (c-file-name file-name)      (uffi:with-cstring (c-file-name file-name)
415        (setq status        (setq status
416              (ecase (gsl-vec-element-type v)              (cond
417                ('integer                ((eq (gsl-vec-element-type v) 'integer)
418                 (wrap-gsl-vector-int-fwrite c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-int-fwrite c-file-name (gsl-vec-ptr v)))
419                ('single-float                ((eq (gsl-vec-element-type v) 'single-float)
420                 (wrap-gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v)))
421                ('double-float                ((eq (gsl-vec-element-type v) 'double-float)
422                 (wrap-gsl-vector-fwrite c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-fwrite c-file-name (gsl-vec-ptr v)))
423                ('complex-single-float                ((equal (gsl-vec-element-type v) '(complex (single-float)))
424                 (wrap-gsl-vector-complex-float-fwrite c-file-name                 (wrap-gsl-vector-complex-float-fwrite c-file-name
425                                                       (gsl-vec-ptr v)))                                                       (gsl-vec-ptr v)))
426                ('complex-double-float                ((equal (gsl-vec-element-type v) '(complex (double-float)))
427                 (wrap-gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v))))))                 (wrap-gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v)))
428                  (t
429                   (error "No matching type")))))
430      status))      status))
431    
432    
433  (defun write-to-file (file-name v)  (defun write-to-file (file-name v)
434    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
435    (let ((status))    (let ((status))
436      (uffi:with-cstring (c-file-name file-name)      (uffi:with-cstring (c-file-name file-name)
437        (setq status        (setq status
438              (ecase (gsl-vec-element-type v)              (cond
439                ('integer                ((eq (gsl-vec-element-type v) 'integer)
440                 (wrap-gsl-vector-int-fprintf c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-int-fprintf c-file-name (gsl-vec-ptr v)))
441                ('single-float                ((eq (gsl-vec-element-type v) 'single-float)
442                 (wrap-gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v)))
443                ('double-float                ((eq (gsl-vec-element-type v) 'double-float)
444                 (wrap-gsl-vector-fprintf c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-fprintf c-file-name (gsl-vec-ptr v)))
445                ('complex-single-float                ((equal (gsl-vec-element-type v) '(complex (single-float)))
446                 (wrap-gsl-vector-complex-float-fprintf c-file-name                 (wrap-gsl-vector-complex-float-fprintf c-file-name
447                                                        (gsl-vec-ptr v)))                                                        (gsl-vec-ptr v)))
448                ('complex-double-float                ((equal (gsl-vec-element-type v) '(complex (double-float)))
449                 (wrap-gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v))))))                 (wrap-gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v)))
450                  (t
451                   (error "No matching type")))))
452      status))      status))
453    
454    
# Line 440  Line 457 
457          (status))          (status))
458      (uffi:with-cstring (c-file-name file-name)      (uffi:with-cstring (c-file-name file-name)
459        (setq status        (setq status
460              (ecase (gsl-vec-element-type v)              (cond
461                ('integer                ((eq (gsl-vec-element-type v) 'integer)
462                 (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v)))
463                ('single-float                ((eq (gsl-vec-element-type v) 'single-float)
464                 (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-float-fread c-file-name (gsl-vec-ptr v)))
465                ('double-float                ((eq (gsl-vec-element-type v) 'double-float)
466                 (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-fread c-file-name (gsl-vec-ptr v)))
467                ('complex-single-float                ((equal (gsl-vec-element-type v) '(complex (single-float)))
468                 (wrap-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)))
469                ('complex-double-float                ((equal (gsl-vec-element-type v) '(complex (double-float)))
470                 (wrap-gsl-vector-complex-fread c-file-name (gsl-vec-ptr v))))))                 (wrap-gsl-vector-complex-fread c-file-name (gsl-vec-ptr v)))
471                  (t
472                   (error "No matching type")))))
473      (values v status)))      (values v status)))
474    
475    
# Line 459  Line 478 
478          (status))          (status))
479      (uffi:with-cstring (c-file-name file-name)      (uffi:with-cstring (c-file-name file-name)
480        (setq status        (setq status
481              (ecase (gsl-vec-element-type v)              (cond
482                ('integer                ((eq (gsl-vec-element-type v) 'integer)
483                 (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v)))
484                ('single-float                ((eq (gsl-vec-element-type v) 'single-float)
485                 (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v)))
486                ('double-float                ((eq (gsl-vec-element-type v) 'double-float)
487                 (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v)))                 (wrap-gsl-vector-fscanf c-file-name (gsl-vec-ptr v)))
488                ('complex-single-float                ((equal (gsl-vec-element-type v) '(complex (single-float)))
489                 (wrap-gsl-vector-complex-float-fscanf c-file-name                 (wrap-gsl-vector-complex-float-fscanf c-file-name
490                                                       (gsl-vec-ptr v)))                                                       (gsl-vec-ptr v)))
491                ('complex-double-float                ((equal (gsl-vec-element-type v) '(complex (double-float)))
492                 (wrap-gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v))))))                 (wrap-gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v)))
493                  (t
494                   (error "No matching type")))))
495      (values v status)))      (values v status)))
496    
497    
498  (defun subvector (v offset n)  (defun subvector (v offset n)
499    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
500    (assert (typep offset 'integer))    (assert (typep offset 'integer))
501    (assert (typep n 'integer))    (assert (typep n 'integer))
502    (assert (< (+ offset n) (gsl-vec-size v)))    (assert (< (+ offset n) (gsl-vec-size v)))
# Line 483  Line 504 
504    ;; allocate any foreign memory for the subvector.    ;; allocate any foreign memory for the subvector.
505    (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v))))    (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v))))
506      (setf (gsl-vec-ptr v-sub)      (setf (gsl-vec-ptr v-sub)
507            (ecase (gsl-vec-element-type v)            (cond
508              ('integer              ((eq (gsl-vec-element-type v) 'integer)
509               (wrap-gsl-vector-int-subvector (gsl-vec-ptr v) offset n))               (wrap-gsl-vector-int-subvector (gsl-vec-ptr v) offset n))
510              ('single-float              ((eq (gsl-vec-element-type v) 'single-float)
511               (wrap-gsl-vector-float-subvector (gsl-vec-ptr v) offset n))               (wrap-gsl-vector-float-subvector (gsl-vec-ptr v) offset n))
512              ('double-float              ((eq (gsl-vec-element-type v) 'double-float)
513               (wrap-gsl-vector-subvector (gsl-vec-ptr v) offset n))               (wrap-gsl-vector-subvector (gsl-vec-ptr v) offset n))
514              ('complex-single-float              ((equal (gsl-vec-element-type v) '(complex (single-float)))
515               (wrap-gsl-vector-complex-float-subvector (gsl-vec-ptr v) offset n))               (wrap-gsl-vector-complex-float-subvector (gsl-vec-ptr v) offset n))
516              ('complex-double-float              ((equal (gsl-vec-element-type v) '(complex (double-float)))
517               (wrap-gsl-vector-complex-subvector (gsl-vec-ptr v) offset n))))               (wrap-gsl-vector-complex-subvector (gsl-vec-ptr v) offset n))
518                (t
519                 (error "No matching type"))))
520      v-sub))      v-sub))
521    
522    
523  (defun subvector-with-stride (v offset stride n)  (defun subvector-with-stride (v offset stride n)
524    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
525    (assert (typep offset 'integer))    (assert (typep offset 'integer))
526    (assert (typep stride 'integer))    (assert (typep stride 'integer))
527    (assert (typep n 'integer))    (assert (typep n 'integer))
# Line 507  Line 530 
530    ;; allocate any foreign memory for the subvector.    ;; allocate any foreign memory for the subvector.
531    (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v))))    (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v))))
532      (setf (gsl-vec-ptr v-sub)      (setf (gsl-vec-ptr v-sub)
533            (ecase (gsl-vec-element-type v)            (cond
534              ('integer              ((eq (gsl-vec-element-type v) 'integer)
535               (wrap-gsl-vector-int-subvector-with-stride (gsl-vec-ptr v)               (wrap-gsl-vector-int-subvector-with-stride (gsl-vec-ptr v)
536                                                          offset stride n))                                                          offset stride n))
537              ('single-float              ((eq (gsl-vec-element-type v) 'single-float)
538               (wrap-gsl-vector-float-subvector-with-stride (gsl-vec-ptr v)               (wrap-gsl-vector-float-subvector-with-stride (gsl-vec-ptr v)
539                                                            offset stride n))                                                            offset stride n))
540              ('double-float              ((eq (gsl-vec-element-type v) 'double-float)
541               (wrap-gsl-vector-subvector-with-stride (gsl-vec-ptr v)               (wrap-gsl-vector-subvector-with-stride (gsl-vec-ptr v)
542                                                      offset stride n))                                                      offset stride n))
543              ('complex-single-float              ((equal (gsl-vec-element-type v) '(complex (single-float)))
544               (wrap-gsl-vector-complex-float-subvector-with-stride               (wrap-gsl-vector-complex-float-subvector-with-stride
545                (gsl-vec-ptr v) offset stride n))                (gsl-vec-ptr v) offset stride n))
546              ('complex-double-float              ((equal (gsl-vec-element-type v) '(complex (double-float)))
547               (wrap-gsl-vector-complex-subvector-with-stride (gsl-vec-ptr v)               (wrap-gsl-vector-complex-subvector-with-stride (gsl-vec-ptr v)
548                                                              offset stride n))))                                                              offset stride n))
549                (t
550                 (error "No matching type"))))
551      v-sub))      v-sub))
552    
553    
554  (defun copy (v-src)  (defun copy (v-src)
555      (assert (eq 'gsl-vec (type-of v-src)))
556    (let* ((v-dest (make-vector (gsl-vec-size v-src)    (let* ((v-dest (make-vector (gsl-vec-size v-src)
557                                :element-type (gsl-vec-element-type v-src)))                                :element-type (gsl-vec-element-type v-src)))
558           (status (ecase (gsl-vec-element-type v-src)           (status (cond
559                     ('integer                     ((eq (gsl-vec-element-type v-src) 'integer)
560                      (gsl-vector-int-memcpy (gsl-vec-ptr v-dest)                      (gsl-vector-int-memcpy (gsl-vec-ptr v-dest)
561                                             (gsl-vec-ptr v-src)))                                             (gsl-vec-ptr v-src)))
562                     ('single-float                     ((eq (gsl-vec-element-type v-src) 'single-float)
563                      (gsl-vector-float-memcpy (gsl-vec-ptr v-dest)                      (gsl-vector-float-memcpy (gsl-vec-ptr v-dest)
564                                               (gsl-vec-ptr v-src)))                                               (gsl-vec-ptr v-src)))
565                     ('double-float                     ((eq (gsl-vec-element-type v-src) 'double-float)
566                      (gsl-vector-memcpy (gsl-vec-ptr v-dest)                      (gsl-vector-memcpy (gsl-vec-ptr v-dest)
567                                         (gsl-vec-ptr v-src)))                                         (gsl-vec-ptr v-src)))
568                     ('complex-single-float                     ((equal (gsl-vec-element-type v-src)
569                               '(complex (single-float)))
570                      (gsl-vector-complex-float-memcpy (gsl-vec-ptr v-dest)                      (gsl-vector-complex-float-memcpy (gsl-vec-ptr v-dest)
571                                                       (gsl-vec-ptr v-src)))                                                       (gsl-vec-ptr v-src)))
572                     ('complex-double-float                     ((equal (gsl-vec-element-type v-src)
573                               '(complex (double-float)))
574                      (gsl-vector-complex-memcpy (gsl-vec-ptr v-dest)                      (gsl-vector-complex-memcpy (gsl-vec-ptr v-dest)
575                                                 (gsl-vec-ptr v-src))))))                                                 (gsl-vec-ptr v-src)))
576                       (t
577                        (error "No matching type")))))
578      (values v-dest status)))      (values v-dest status)))
579    
580    
581  (defun swap (va vb)  (defun swap (va vb)
582    (assert (eq 'gsl (type-of va)))    (assert (eq 'gsl-vec (type-of va)))
583    (assert (eq 'gsl (type-of vb)))    (assert (eq 'gsl-vec (type-of vb)))
584    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
585    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
586    (let ((status    (let ((status
587           (ecase (gsl-vec-element-type va)           (cond
588             ('integer             ((eq (gsl-vec-element-type va) 'integer)
589              (gsl-vector-int-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-int-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
590             ('single-float             ((eq (gsl-vec-element-type va) 'single-float)
591              (gsl-vector-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
592             ('double-float             ((eq (gsl-vec-element-type va) 'double-float)
593              (gsl-vector-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
594             ('complex-single-float             ((equal (gsl-vec-element-type va) '(complex (single-float)))
595              (gsl-vector-complex-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-complex-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
596             ('complex-double-float             ((equal (gsl-vec-element-type va) '(complex (double-float)))
597              (gsl-vector-complex-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))))))              (gsl-vector-complex-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
598    (values va status)))             (t
599                (error "No matching type")))))
600        (values va status)))
601    
602    
603  (defun swap-elements (v i j)  (defun swap-elements (v i j)
604    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
605    (assert (typep i 'integer))    (assert (typep i 'integer))
606    (assert (typep j 'integer))    (assert (typep j 'integer))
607    (assert (< i (gsl-vec-size v)))    (assert (< i (gsl-vec-size v)))
608    (assert (< j (gsl-vec-size v)))    (assert (< j (gsl-vec-size v)))
609    (let ((status    (let ((status
610           (ecase (gsl-vec-element-type v)           (cond
611             ('integer             ((eq (gsl-vec-element-type v) 'integer)
612              (gsl-vector-int-swap-elements (gsl-vec-ptr v) i j))              (gsl-vector-int-swap-elements (gsl-vec-ptr v) i j))
613             ('single-float             ((eq (gsl-vec-element-type v) 'single-float)
614              (gsl-vector-float-swap-elements (gsl-vec-ptr v) i j))              (gsl-vector-float-swap-elements (gsl-vec-ptr v) i j))
615             ('double-float             ((eq (gsl-vec-element-type v) 'double-float)
616              (gsl-vector-swap-elements (gsl-vec-ptr v) i j))              (gsl-vector-swap-elements (gsl-vec-ptr v) i j))
617             ('complex-single-float             ((equal (gsl-vec-element-type v) '(complex (single-float)))
618              (gsl-vector-complex-float-swap-elements (gsl-vec-ptr v) i j))              (gsl-vector-complex-float-swap-elements (gsl-vec-ptr v) i j))
619             ('complex-double-float             ((equal (gsl-vec-element-type v) '(complex (double-float)))
620              (gsl-vector-complex-swap-elements (gsl-vec-ptr v) i j)))))              (gsl-vector-complex-swap-elements (gsl-vec-ptr v) i j))
621               (t
622                (error "No matching type")))))
623      (values v status)))      (values v status)))
624    
625    
626  (defun reverse-vector (v)  (defun reverse-vector (v)
627    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
628    (let ((status    (let ((status
629           (ecase (gsl-vec-element-type v)           (cond
630             ('integer             ((eq (gsl-vec-element-type v) 'integer)
631              (gsl-vector-int-reverse (gsl-vec-ptr v)))              (gsl-vector-int-reverse (gsl-vec-ptr v)))
632             ('single-float             ((eq (gsl-vec-element-type v) 'single-float)
633              (gsl-vector-float-reverse (gsl-vec-ptr v)))              (gsl-vector-float-reverse (gsl-vec-ptr v)))
634             ('double-float             ((eq (gsl-vec-element-type v) 'double-float)
635              (gsl-vector-reverse (gsl-vec-ptr v)))              (gsl-vector-reverse (gsl-vec-ptr v)))
636             ('complex-single-float             ((equal (gsl-vec-element-type v) '(complex (single-float)))
637              (gsl-vector-complex-float-reverse (gsl-vec-ptr v)))              (gsl-vector-complex-float-reverse (gsl-vec-ptr v)))
638             ('complex-double-float             ((equal (gsl-vec-element-type v) '(complex (double-float)))
639              (gsl-vector-complex-reverse (gsl-vec-ptr v))))))              (gsl-vector-complex-reverse (gsl-vec-ptr v)))
640               (t
641                (error "No matching type")))))
642      (values v status)))      (values v status)))
643    
644    
645  (defun add (va vb)  (defun add (va vb)
646    (assert (eq 'gsl (type-of va)))    (assert (eq 'gsl-vec (type-of va)))
647    (assert (eq 'gsl (type-of vb)))    (assert (eq 'gsl-vec (type-of vb)))
648    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
649    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
650    (let ((status    (let ((status
651           (ecase (gsl-vec-element-type va)           (cond
652             ('integer             ((eq (gsl-vec-element-type va) 'integer)
653              (gsl-vector-int-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-int-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))
654             ('single-float             ((eq (gsl-vec-element-type va) 'single-float)
655              (gsl-vector-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))
656             ('double-float             ((eq (gsl-vec-element-type va) 'double-float)
657              (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb))))))              (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))
658               (t
659                (error "No matching type")))))
660    (values va status)))    (values va status)))
661    
662    
663  (defun sub (va vb)  (defun sub (va vb)
664    (assert (eq 'gsl (type-of va)))    (assert (eq 'gsl-vec (type-of va)))
665    (assert (eq 'gsl (type-of vb)))    (assert (eq 'gsl-vec (type-of vb)))
666    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
667    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
668    (let ((status    (let ((status
669           (ecase (gsl-vec-element-type va)           (cond
670             ('integer             ((eq (gsl-vec-element-type va) 'integer)
671              (gsl-vector-int-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-int-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))
672             ('single-float             ((eq (gsl-vec-element-type va) 'single-float)
673              (gsl-vector-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))
674             ('double-float             ((eq (gsl-vec-element-type va) 'double-float)
675              (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))))))              (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))
676               (t
677                (error "No matching type")))))
678    (values va status)))    (values va status)))
679    
680    
681  (defun mul (va vb)  (defun mul (va vb)
682    (assert (eq 'gsl (type-of va)))    (assert (eq 'gsl-vec (type-of va)))
683    (assert (eq 'gsl (type-of vb)))    (assert (eq 'gsl-vec (type-of vb)))
684    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
685    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
686    (let ((status    (let ((status
687           (ecase (gsl-vec-element-type va)           (cond
688             ('integer             ((eq (gsl-vec-element-type va) 'integer)
689              (gsl-vector-int-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-int-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))
690             ('single-float             ((eq (gsl-vec-element-type va) 'single-float)
691              (gsl-vector-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))
692             ('double-float             ((eq (gsl-vec-element-type va) 'double-float)
693              (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))))))              (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))
694               (t
695                (error "No matching type")))))
696    (values va status)))    (values va status)))
697    
698    
699  (defun div (va vb)  (defun div (va vb)
700    (assert (eq 'gsl (type-of va)))    (assert (eq 'gsl-vec (type-of va)))
701    (assert (eq 'gsl (type-of vb)))    (assert (eq 'gsl-vec (type-of vb)))
702    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))    (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
703    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))    (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
704    (let ((status    (let ((status
705           (ecase (gsl-vec-element-type va)           (cond
706             ('integer             ((eq (gsl-vec-element-type va) 'integer)
707              (gsl-vector-int-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-int-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))
708             ('single-float             ((eq (gsl-vec-element-type va) 'single-float)
709              (gsl-vector-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))              (gsl-vector-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))
710             ('double-float             ((eq (gsl-vec-element-type va) 'double-float)
711              (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb))))))              (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))
712               (t
713                (error "No matching type")))))
714    (values va status)))    (values va status)))
715    
716    
717  (defun scale (v x)  (defun scale (v x)
718    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
719    (assert (eq (gsl-vec-element-type v) (type-of x)))    (assert (typep x (gsl-vec-element-type v)))
720    (let ((status    (let ((status
721           (ecase (gsl-vec-element-type v)           (cond
722             ('integer             ((eq (gsl-vec-element-type v) 'integer)
723              (gsl-vector-int-scale (gsl-vec-ptr v) x))              (gsl-vector-int-scale (gsl-vec-ptr v) x))
724             ('single-float             ((eq (gsl-vec-element-type v) 'single-float)
725              (gsl-vector-float-scale (gsl-vec-ptr v) x))              (gsl-vector-float-scale (gsl-vec-ptr v) x))
726             ('double-float             ((eq (gsl-vec-element-type v) 'double-float)
727              (gsl-vector-scale (gsl-vec-ptr v) x)))))              (gsl-vector-scale (gsl-vec-ptr v) x))
728               (t
729                (error "No matching type")))))
730    (values v status)))    (values v status)))
731    
732    
733  (defun add-constant (v x)  (defun add-constant (v x)
734    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
735    (assert (eq (gsl-vec-element-type v) (type-of x)))    (assert (typep x (gsl-vec-element-type v)))
736    (let ((status    (let ((status
737           (ecase (gsl-vec-element-type v)           (cond
738             ('integer             ((eq (gsl-vec-element-type v) 'integer)
739              (gsl-vector-int-add-constant (gsl-vec-ptr v) x))              (gsl-vector-int-add-constant (gsl-vec-ptr v) x))
740             ('single-float             ((eq (gsl-vec-element-type v) 'single-float)
741              (gsl-vector-float-add-constant (gsl-vec-ptr v) x))              (gsl-vector-float-add-constant (gsl-vec-ptr v) x))
742             ('double-float             ((eq (gsl-vec-element-type v) 'double-float)
743              (gsl-vector-add-constant (gsl-vec-ptr v) x)))))              (gsl-vector-add-constant (gsl-vec-ptr v) x))
744               (t
745                (error "No matching type")))))
746    (values v status)))    (values v status)))
747    
748    
749  (defun max-value (v)  (defun max-value (v)
750    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
751    (ecase (gsl-vec-element-type v)    (cond
752      ('integer      ((eq (gsl-vec-element-type v) 'integer)
753       (gsl-vector-int-max (gsl-vec-ptr v)))       (gsl-vector-int-max (gsl-vec-ptr v)))
754      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
755       (gsl-vector-float-max (gsl-vec-ptr v)))       (gsl-vector-float-max (gsl-vec-ptr v)))
756      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
757       (gsl-vector-max (gsl-vec-ptr v)))))       (gsl-vector-max (gsl-vec-ptr v)))
758        (t
759         (error "No matching type"))))
760    
761    
762  (defun min-value (v)  (defun min-value (v)
763    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
764    (ecase (gsl-vec-element-type v)    (cond
765      ('integer      ((eq (gsl-vec-element-type v) 'integer)
766       (gsl-vector-int-min (gsl-vec-ptr v)))       (gsl-vector-int-min (gsl-vec-ptr v)))
767      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
768       (gsl-vector-float-min (gsl-vec-ptr v)))       (gsl-vector-float-min (gsl-vec-ptr v)))
769      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
770       (gsl-vector-min (gsl-vec-ptr v)))))       (gsl-vector-min (gsl-vec-ptr v)))
771        (t
772         (error "No matching type"))))
773    
774    
775  (defun max-index (v)  (defun max-index (v)
776    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
777    (ecase (gsl-vec-element-type v)    (cond
778      ('integer      ((eq (gsl-vec-element-type v) 'integer)
779       (gsl-vector-int-max-index (gsl-vec-ptr v)))       (gsl-vector-int-max-index (gsl-vec-ptr v)))
780      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
781       (gsl-vector-float-max-index (gsl-vec-ptr v)))       (gsl-vector-float-max-index (gsl-vec-ptr v)))
782      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
783       (gsl-vector-max-index (gsl-vec-ptr v)))))       (gsl-vector-max-index (gsl-vec-ptr v)))
784        (t
785         (error "No matching type"))))
786    
787    
788  (defun min-index (v)  (defun min-index (v)
789    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
790    (ecase (gsl-vec-element-type v)    (cond
791      ('integer      ((eq (gsl-vec-element-type v) 'integer)
792       (gsl-vector-int-min-index (gsl-vec-ptr v)))       (gsl-vector-int-min-index (gsl-vec-ptr v)))
793      ('single-float      ((eq (gsl-vec-element-type v) 'single-float)
794       (gsl-vector-float-min-index (gsl-vec-ptr v)))       (gsl-vector-float-min-index (gsl-vec-ptr v)))
795      ('double-float      ((eq (gsl-vec-element-type v) 'double-float)
796       (gsl-vector-min-index (gsl-vec-ptr v)))))       (gsl-vector-min-index (gsl-vec-ptr v)))
797        (t
798         (error "No matching type"))))
799    
800    
801  (defun min-max-indicies (v)  (defun min-max-indicies (v)
802    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
803    (let ((min-ptr (uffi:allocate-foreign-object 'size-t))    (let ((min-ptr (uffi:allocate-foreign-object 'size-t))
804          (max-ptr (uffi:allocate-foreign-object 'size-t)))          (max-ptr (uffi:allocate-foreign-object 'size-t)))
805      (ecase (gsl-vec-element-type v)      (cond
806        ('integer        ((eq (gsl-vec-element-type v) 'integer)
807         (gsl-vector-int-minmax-index (gsl-vec-ptr v) min-ptr max-ptr))         (gsl-vector-int-minmax-index (gsl-vec-ptr v) min-ptr max-ptr))
808        ('single-float        ((eq (gsl-vec-element-type v) 'single-float)
809         (gsl-vector-float-minmax-index (gsl-vec-ptr v) min-ptr max-ptr))         (gsl-vector-float-minmax-index (gsl-vec-ptr v) min-ptr max-ptr))
810        ('double-float        ((eq (gsl-vec-element-type v) 'double-float)
811         (gsl-vector-minmax-index (gsl-vec-ptr v) min-ptr max-ptr)))         (gsl-vector-minmax-index (gsl-vec-ptr v) min-ptr max-ptr))
812          (t
813           (error "No matching type")))
814      (prog1      (prog1
815          (list (uffi:deref-pointer min-ptr 'size-t)          (list (uffi:deref-pointer min-ptr 'size-t)
816                (uffi:deref-pointer max-ptr 'size-t))                (uffi:deref-pointer max-ptr 'size-t))
# Line 759  Line 819 
819    
820    
821  (defun min-max-values (v)  (defun min-max-values (v)
822    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
823    (destructuring-bind (min-index max-index)    (destructuring-bind (min-index max-index)
824        (min-max-indicies v)        (min-max-indicies v)
825      (list (get-element v min-index)      (list (get-element v min-index)
# Line 767  Line 827 
827    
828    
829  (defun isnull (v)  (defun isnull (v)
830    (assert (eq 'gsl (type-of v)))    (assert (eq 'gsl-vec (type-of v)))
831    (1/0->t/nil (ecase (gsl-vec-element-type v)    (1/0->t/nil (cond
832                  ('integer                  ((eq (gsl-vec-element-type v) 'integer)
833                   (gsl-vector-int-isnull (gsl-vec-ptr v)))                   (gsl-vector-int-isnull (gsl-vec-ptr v)))
834                  ('single-float                  ((eq (gsl-vec-element-type v) 'single-float)
835                   (gsl-vector-float-isnull (gsl-vec-ptr v)))                   (gsl-vector-float-isnull (gsl-vec-ptr v)))
836                  ('double-float                  ((eq (gsl-vec-element-type v) 'double-float)
837                   (gsl-vector-isnull (gsl-vec-ptr v)))                   (gsl-vector-isnull (gsl-vec-ptr v)))
838                  ('complex-single-float                  ((equal (gsl-vec-element-type v) '(complex (single-float)))
839                   (gsl-vector-complex-float-isnull (gsl-vec-ptr v)))                   (gsl-vector-complex-float-isnull (gsl-vec-ptr v)))
840                  ('complex-double-float                  ((equal (gsl-vec-element-type v) '(complex (double-float)))
841                   (gsl-vector-complex-isnull (gsl-vec-ptr v))))))                   (gsl-vector-complex-isnull (gsl-vec-ptr v)))
842                    (t
843                     (error "No matching type")))))
844    
845  ;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v)  ;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v)
846  ;; Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex *v)  ;; Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex *v)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5