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

Contents of /cl-gsl/vector.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (hide annotations)
Wed Mar 2 01:04:53 2005 UTC (9 years, 1 month ago) by edenny
Branch: MAIN
Branch point for: cl-gsl
Initial revision
1 edenny 1.1 ;;;; -*- Mode: Lisp; Synatx: ANSI-Common-Lisp; Base: 10 -*-
2     ;;;;
3     ;;;; Copyright (C) 2005 Edgar Denny <edgardenny@comcast.net>
4     ;;;; This file is part of CL-GSL.
5     ;;;;
6     ;;;; This program is free software; you can redistribute it and/or modify
7     ;;;; it under the terms of the GNU General Public License as published by
8     ;;;; the Free Software Foundation; either version 2 of the License, or
9     ;;;; (at your option) any later version.
10     ;;;;
11     ;;;; This program is distributed in the hope that it will be useful,
12     ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13     ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14     ;;;; GNU General Public License for more details.
15     ;;;;
16     ;;;; You should have received a copy of the GNU General Public License
17     ;;;; along with this program; if not, write to the Free Software
18     ;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19    
20     (in-package #:cl-gsl-vector)
21    
22     (defmacro def-vector-type-funcs% (typ)
23     (let ((type-ptr)
24     (type-val)
25     (type-val-ptr)
26     (type-string))
27     (cond
28     ((eq typ 'double-float)
29     (setq type-ptr 'gsl-vector-ptr)
30     (setq type-val :double)
31     (setq type-val-ptr '(* :double))
32     (setq type-string "vector"))
33     ((eq typ 'single-float)
34     (setq type-ptr 'gsl-vector-float-ptr)
35     (setq type-val :float)
36     (setq type-val-ptr '(* :float))
37     (setq type-string "vector_float"))
38     ((eq typ 'integer)
39     (setq type-ptr 'gsl-vector-int-ptr)
40     (setq type-val :int)
41     (setq type-val-ptr '(* :int))
42     (setq type-string "vector_int"))
43     ((eq typ 'complex-double-float)
44     (setq type-ptr 'gsl-vector-complex-ptr)
45     (setq type-val 'gsl-complex)
46     (setq type-val-ptr '(* gsl-complex))
47     (setq type-string "vector_complex"))
48     ((eq typ 'complex-single-float)
49     (setq type-ptr 'gsl-vector-complex-float-ptr)
50     (setq type-val 'gsl-complex-float)
51     (setq type-val-ptr '(* gsl-complex-float))
52     (setq type-string "vector_complex_float"))
53     (t
54     (error "no matching type.")))
55    
56     `(progn
57     (defun-foreign ,(concatenate 'string "gsl_" type-string "_alloc")
58     ((size size-t))
59     ,type-ptr)
60    
61     (defun-foreign ,(concatenate 'string "gsl_" type-string "_free")
62     ((v ,type-ptr))
63     :void)
64    
65     (defun-foreign ,(concatenate 'string "gsl_" type-string "_get")
66     ((v ,type-ptr)
67     (i size-t))
68     ,type-val)
69    
70     (defun-foreign ,(concatenate 'string "gsl_" type-string "_set")
71     ((v ,type-ptr)
72     (i size-t)
73     (x ,type-val))
74     :void)
75    
76     (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_all")
77     ((v ,type-ptr)
78     (x ,type-val))
79     :void)
80    
81     (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_zero")
82     ((v ,type-ptr))
83     :void)
84    
85     (defun-foreign ,(concatenate 'string "gsl_" type-string "_set_basis")
86     ((v ,type-ptr)
87     (i size-t))
88     :void)
89    
90     (defun-foreign ,(concatenate 'string "gsl_" type-string "_memcpy")
91     ((v1 ,type-ptr)
92     (v2 ,type-ptr))
93     :int)
94    
95     (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap")
96     ((v1 ,type-ptr)
97     (v2 ,type-ptr))
98     :int)
99    
100     (defun-foreign ,(concatenate 'string "gsl_" type-string "_swap_elements")
101     ((v1 ,type-ptr)
102     (i size-t)
103     (j size-t))
104     :int)
105    
106     (defun-foreign ,(concatenate 'string "gsl_" type-string "_reverse")
107     ((v1 ,type-ptr))
108     :int)
109    
110     (defun-foreign ,(concatenate 'string "gsl_" type-string "_add")
111     ((va ,type-ptr)
112     (vb ,type-ptr))
113     :int)
114    
115     (defun-foreign ,(concatenate 'string "gsl_" type-string "_sub")
116     ((va ,type-ptr)
117     (vb ,type-ptr))
118     :int)
119    
120     (defun-foreign ,(concatenate 'string "gsl_" type-string "_mul")
121     ((va ,type-ptr)
122     (vb ,type-ptr))
123     :int)
124    
125     (defun-foreign ,(concatenate 'string "gsl_" type-string "_div")
126     ((va ,type-ptr)
127     (vb ,type-ptr))
128     :int)
129    
130     (defun-foreign ,(concatenate 'string "gsl_" type-string "_scale")
131     ((vec ,type-ptr)
132     (x ,type-val))
133     :int)
134    
135     (defun-foreign ,(concatenate 'string "gsl_" type-string "_add_constant")
136     ((vec ,type-ptr)
137     (x ,type-val))
138     :int)
139    
140     (defun-foreign ,(concatenate 'string "gsl_" type-string "_max")
141     ((vec ,type-ptr))
142     ,type-val)
143    
144     (defun-foreign ,(concatenate 'string "gsl_" type-string "_min")
145     ((vec ,type-ptr))
146     ,type-val)
147    
148     (defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax")
149     ((vec ,type-ptr)
150     (min ,type-val-ptr)
151     (max ,type-val-ptr))
152     :void)
153    
154     (defun-foreign ,(concatenate 'string "gsl_" type-string "_max_index")
155     ((vec ,type-ptr))
156     size-t)
157    
158     (defun-foreign ,(concatenate 'string "gsl_" type-string "_min_index")
159     ((vec ,type-ptr))
160     size-t)
161    
162     (defun-foreign ,(concatenate 'string "gsl_" type-string "_minmax_index")
163     ((vec ,type-ptr)
164     (min size-t-ptr)
165     (max size-t-ptr))
166     :void)
167    
168     (defun-foreign ,(concatenate 'string "gsl_" type-string "_isnull")
169     ((vec ,type-ptr))
170     :int)
171    
172     (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fwrite")
173     ((fn :cstring)
174     (v ,type-ptr))
175     :int)
176    
177     (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fread")
178     ((fn :cstring)
179     (v ,type-ptr))
180     :int)
181    
182     (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fprintf")
183     ((fn :cstring)
184     (v ,type-ptr))
185     :int)
186    
187     (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string "_fscanf")
188     ((fn :cstring)
189     (v ,type-ptr))
190     :int)
191    
192     (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string
193     "_subvector")
194     ((v gsl-vector-ptr)
195     (offset size-t)
196     (n size-t))
197     ,type-ptr)
198    
199     (defun-foreign ,(concatenate 'string "wrap_gsl_" type-string
200     "_subvector_with_stride")
201     ((v gsl-vector-ptr)
202     (offset size-t)
203     (stride size-t)
204     (n size-t))
205     ,type-ptr))))
206    
207    
208     (def-vector-type-funcs% double-float)
209     (def-vector-type-funcs% single-float)
210     (def-vector-type-funcs% integer)
211     (def-vector-type-funcs% complex-double-float)
212     (def-vector-type-funcs% complex-single-float)
213    
214     (defstruct gsl-vec
215     ;; TODO: print-function ?
216     ptr
217     size
218     element-type)
219    
220     (defun alloc (v)
221     (declare (gsl-vec v))
222     (ecase (gsl-vec-element-type v)
223     ('integer
224     (setf (gsl-vec-ptr v) (gsl-vector-int-alloc (gsl-vec-size v))))
225     ('single-float
226     (setf (gsl-vec-ptr v) (gsl-vector-float-alloc (gsl-vec-size v))))
227     ('double-float
228     (setf (gsl-vec-ptr v) (gsl-vector-alloc (gsl-vec-size v))))
229     ('complex-single-float
230     (setf (gsl-vec-ptr v) (gsl-vector-complex-float-alloc (gsl-vec-size v))))
231     ('complex-double-float
232     (setf (gsl-vec-ptr v) (gsl-vector-complex-alloc (gsl-vec-size v))))))
233    
234    
235     (defun free (v)
236     (declare (gsl-vec v))
237     (ecase (gsl-vec-element-type v)
238     ('integer
239     (gsl-vector-int-free (gsl-vec-ptr v)))
240     ('single-float
241     (gsl-vector-float-free (gsl-vec-ptr v)))
242     ('double-float
243     (gsl-vector-free (gsl-vec-ptr v)))
244     ('complex-single-float
245     (gsl-vector-complex-float-free (gsl-vec-ptr v)))
246     ('complex-double-float
247     (gsl-vector-complex-free (gsl-vec-ptr v))))
248     (setf (gsl-vec-ptr v) nil)
249     (setf (gsl-vec-size v) nil)
250     (setf (gsl-vec-element-type v) nil))
251    
252    
253     (defun get-element (v i)
254     (declare (gsl-vec v))
255     (assert (typep i 'integer))
256     (assert (< i (gsl-vec-size v)))
257     (ecase (gsl-vec-element-type v)
258     ('integer
259     (gsl-vector-int-get (gsl-vec-ptr v) i))
260     ('single-float
261     (gsl-vector-float-get (gsl-vec-ptr v) i))
262     ('double-float
263     (gsl-vector-get (gsl-vec-ptr v) i))
264     ('complex-single-float
265     (gsl-complex-float->complex (gsl-vector-complex-float-get
266     (gsl-vec-ptr v) i)))
267     ('complex-double-float
268     (gsl-complex->complex (gsl-vector-complex-get (gsl-vec-ptr v) i)))))
269    
270    
271     (defun set-element (v i x)
272     (declare (gsl-vec v))
273     (assert (eq (type-of x) (gsl-vec-element-type v)))
274     (assert (typep i 'integer))
275     (assert (< i (gsl-vec-size v)))
276     (ecase (gsl-vec-element-type v)
277     ('integer
278     (gsl-vector-int-set (gsl-vec-ptr v) i x))
279     ('single-float
280     (gsl-vector-float-set (gsl-vec-ptr v) i x))
281     ('double-float
282     (gsl-vector-set (gsl-vec-ptr v) i x))
283     ('complex-single-float
284     (gsl-vector-complex-float-set (gsl-vec-ptr v)
285     i
286     (complex->gsl-complex-float x)))
287     ('complex-double-float
288     (gsl-vector-complex-set (gsl-vec-ptr v)
289     i
290     (complex->gsl-complex x)))))
291    
292    
293     (defun set-all (v x)
294     (declare (gsl-vec v))
295     (assert (eq (type-of x) (gsl-vec-element-type v)))
296     (ecase (gsl-vec-element-type v)
297     ('integer
298     (gsl-vector-int-set-all (gsl-vec-ptr v) x))
299     ('single-float
300     (gsl-vector-float-set-all (gsl-vec-ptr v) x))
301     ('double-float
302     (gsl-vector-set-all (gsl-vec-ptr v) x))
303     ('complex-single-float
304     (gsl-vector-complex-float-set-all (gsl-vec-ptr v)
305     (complex->gsl-complex-float x)))
306     ('complex-double-float
307     (gsl-vector-complex-set-all (gsl-vec-ptr v)
308     (complex->gsl-complex x)))))
309    
310     (defun set-zero (v)
311     (declare (gsl-vec v))
312     (ecase (gsl-vec-element-type v)
313     ('integer
314     (gsl-vector-int-set-zero (gsl-vec-ptr v)))
315     ('single-float
316     (gsl-vector-float-set-zero (gsl-vec-ptr v)))
317     ('double-float
318     (gsl-vector-set-zero (gsl-vec-ptr v)))
319     ('complex-single-float
320     (gsl-vector-complex-float-set-zero (gsl-vec-ptr v)
321     (complex->gsl-complex-float)))
322     ('complex-double-float
323     (gsl-vector-complex-set-zero (gsl-vec-ptr v)
324     (complex->gsl-complex)))))
325    
326    
327     (defun set-basis (v i)
328     (declare (gsl-vec v))
329     (assert (typep i 'integer))
330     (assert (< i (gsl-vec-size v)))
331     (ecase (gsl-vec-element-type v)
332     ('integer
333     (gsl-vector-int-set-basis (gsl-vec-ptr v) i))
334     ('single-float
335     (gsl-vector-float-set-basis (gsl-vec-ptr v) i))
336     ('double-float
337     (gsl-vector-set-basis (gsl-vec-ptr v) i))
338     ('complex-single-float
339     (gsl-vector-complex-float-set-basis (gsl-vec-ptr v)
340     (complex->gsl-complex-float i)))
341     ('complex-double-float
342     (gsl-vector-complex-set-basis (gsl-vec-ptr v)
343     (complex->gsl-complex i)))))
344    
345    
346     (defun make-vector (size &key (element-type 'double-float) initial-element
347     initial-contents)
348     (assert (typep size 'integer))
349     (assert (find element-type '(integer single-float double-float
350     complex-single-float double-single-float)))
351     (let ((v (make-gsl-vec :size size :element-type element-type)))
352     (setf (gsl-vec-ptr v) (gsl-vector:alloc v))
353     (cond
354     ((and initial-element initial-contents)
355     (error "cannot define both initial-element and initial-contents keys"))
356     (initial-element
357     (gsl-vector:set-all v initial-element))
358     (initial-contents
359     (cond
360     ((listp initial-contents)
361     (do ((x initial-contents (cdr x))
362     (i 0 (1+ i)))
363     ((= i size))
364     (gsl-vector:set-element v i (car x))))
365     ((vectorp initial-contents)
366     (do ((i 0 (1+ i)))
367     ((= i size))
368     (gsl-vector:set-element v i (aref initial-contents i))))
369     (t
370     (error "initial-contents must be either a list or a vector.")))))
371     v))
372    
373    
374     (defun write-to-binary-file (file-name v)
375     (declare (gsl-vector v))
376     (let ((status))
377     (with-cstring (c-file-name file-name)
378     (setq status
379     (ecase (gsl-vec-element-type v)
380     ('integer
381     (wrap-gsl-vector-int-fwrite c-file-name (gsl-vec-ptr v)))
382     ('single-float
383     (gsl-vector-float-fwrite c-file-name (gsl-vec-ptr v)))
384     ('double-float
385     (gsl-vector-fwrite c-file-name (gsl-vec-ptr v)))
386     ('complex-single-float
387     (gsl-vector-complex-float-fwrite c-file-name (gsl-vec-ptr v)))
388     ('complex-double-float
389     (gsl-vector-complex-fwrite c-file-name (gsl-vec-ptr v))))))
390     status))
391    
392    
393     (defun write-to-file (file-name v)
394     (declare (gsl-vector v))
395     (let ((status))
396     (with-cstring (c-file-name file-name)
397     (setq status
398     (ecase (gsl-vec-element-type v)
399     ('integer
400     (wrap-gsl-vector-int-fprintf c-file-name (gsl-vec-ptr v)))
401     ('single-float
402     (gsl-vector-float-fprintf c-file-name (gsl-vec-ptr v)))
403     ('double-float
404     (gsl-vector-fprintf c-file-name (gsl-vec-ptr v)))
405     ('complex-single-float
406     (gsl-vector-complex-float-fprintf c-file-name (gsl-vec-ptr v)))
407     ('complex-double-float
408     (gsl-vector-complex-fprintf c-file-name (gsl-vec-ptr v))))))
409     status))
410    
411    
412     (defun read-from-binary-file (file-name size element-type)
413     (let ((v (make-vector :size size :element-type element-type))
414     (status))
415     (with-cstring (c-file-name file-name)
416     (setq status
417     (ecase (gsl-vec-element-type v)
418     ('integer
419     (wrap-gsl-vector-int-fread c-file-name (gsl-vec-ptr v)))
420     ('single-float
421     (gsl-vector-float-fread c-file-name (gsl-vec-ptr v)))
422     ('double-float
423     (gsl-vector-fread c-file-name (gsl-vec-ptr v)))
424     ('complex-single-float
425     (gsl-vector-complex-float-fread c-file-name (gsl-vec-ptr v)))
426     ('complex-double-float
427     (gsl-vector-complex-fread c-file-name (gsl-vec-ptr v))))))
428     (values v status)))
429    
430    
431     (defun read-from-file (file-name size element-type)
432     (let ((v (make-vector :size size :element-type element-type))
433     (status))
434     (with-cstring (c-file-name file-name)
435     (setq status
436     (ecase (gsl-vec-element-type v)
437     ('integer
438     (wrap-gsl-vector-int-fscanf c-file-name (gsl-vec-ptr v)))
439     ('single-float
440     (gsl-vector-float-fscanf c-file-name (gsl-vec-ptr v)))
441     ('double-float
442     (gsl-vector-fscanf c-file-name (gsl-vec-ptr v)))
443     ('complex-single-float
444     (gsl-vector-complex-float-fscanf c-file-name (gsl-vec-ptr v)))
445     ('complex-double-float
446     (gsl-vector-complex-fscanf c-file-name (gsl-vec-ptr v))))))
447     (values v status)))
448    
449    
450     (defun subvector (v offset n)
451     (declare (gsl-vector v))
452     (assert (typep offset 'integer))
453     (assert (typep n 'integer))
454     (assert (< (+ offset n) (gsl-vec-size v)))
455     ;; use make-gsl-vec here rather than make-vector - we do not want to
456     ;; allocate any foreign memory for the subvector.
457     (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v))))
458     (setf (gsl-vec-ptr v-sub)
459     (ecase (gsl-vec-element-type v)
460     ('integer
461     (wrap-gsl-vector-int-subvector (gsl-vec-ptr v) offset n))
462     ('single-float
463     (wrap-gsl-vector-float-subvector (gsl-vec-ptr v) offset n))
464     ('double-float
465     (wrap-gsl-vector-subvector (gsl-vec-ptr v) offset n))
466     ('complex-single-float
467     (wrap-gsl-vector-complex-float-subvector (gsl-vec-ptr v) offset n))
468     ('complex-double-float
469     (wrap-gsl-vector-complex-subvector (gsl-vec-ptr v) offset n))))
470     v-sub))
471    
472    
473     (defun subvector-with-stride (v offset stride n)
474     (declare (gsl-vector v))
475     (assert (typep offset 'integer))
476     (assert (typep stride 'integer))
477     (assert (typep n 'integer))
478     (assert (< (* (+ offset n) stride) (gsl-vec-size v)))
479     ;; use make-gsl-vec here rather than make-vector - we do not want to
480     ;; allocate any foreign memory for the subvector.
481     (let ((v-sub (make-gsl-vec :size n :element-type (gsl-vec-element-type v))))
482     (setf (gsl-vec-ptr v-sub)
483     (ecase (gsl-vec-element-type v)
484     ('integer
485     (wrap-gsl-vector-int-subvector-with-stride (gsl-vec-ptr v)
486     offset stride n))
487     ('single-float
488     (wrap-gsl-vector-float-subvector-with-stride (gsl-vec-ptr v)
489     offset stride n))
490     ('double-float
491     (wrap-gsl-vector-subvector-with-stride (gsl-vec-ptr v)
492     offset stride n))
493     ('complex-single-float
494     (wrap-gsl-vector-complex-float-subvector-with-stride
495     (gsl-vec-ptr v) offset stride n))
496     ('complex-double-float
497     (wrap-gsl-vector-complex-subvector-with-stride (gsl-vec-ptr v)
498     offset stride n))))
499     v-sub))
500    
501    
502     (defun copy (v-src)
503     (let* ((v-dest (make-vector :size (gsl-vec-size v-src)
504     :element-type (gsl-vec-element-type v-src)))
505     (status (ecase (gsl-vec-element-type v-src)
506     ('integer
507     (gsl-vector-int-memcpy (gsl-vec-ptr v-dest)
508     (gsl-vec-ptr v-src)))
509     ('single-float
510     (gsl-vector-float-memcpy (gsl-vec-ptr v-dest)
511     (gsl-vec-ptr v-src)))
512     ('double-float
513     (gsl-vector-memcpy (gsl-vec-ptr v-dest)
514     (gsl-vec-ptr v-src)))
515     ('complex-single-float
516     (gsl-vector-complex-float-memcpy (gsl-vec-ptr v-dest)
517     (gsl-vec-ptr v-src)))
518     ('complex-double-float
519     (gsl-vector-complex-memcpy (gsl-vec-ptr v-dest)
520     (gsl-vec-ptr v-src))))))
521     (values v-dest status)))
522    
523    
524     (defun swap (va vb)
525     (declare (gsl-vec va) (gsl-vec vb))
526     (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
527     (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
528     (let ((status
529     (ecase (gsl-vec-element-type va)
530     ('integer
531     (gsl-vector-int-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
532     ('single-float
533     (gsl-vector-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
534     ('double-float
535     (gsl-vector-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
536     ('complex-single-float
537     (gsl-vector-complex-float-swap (gsl-vec-ptr va) (gsl-vec-ptr vb)))
538     ('complex-double-float
539     (gsl-vector-complex-swap (gsl-vec-ptr va) (gsl-vec-ptr vb))))))
540     (values va status)))
541    
542    
543     (defun swap-elements (v i j)
544     (declare (gsl-vec v) (integer i) (integer j))
545     (assert (typep i 'integer))
546     (assert (typep j 'integer))
547     (assert (< i (gsl-vec-size v)))
548     (assert (< j (gsl-vec-size v)))
549     (let ((status
550     (ecase (gsl-vec-element-type v)
551     ('integer
552     (gsl-vector-int-swap-elements (gsl-vec-ptr v) i j))
553     ('single-float
554     (gsl-vector-float-swap-elements (gsl-vec-ptr v) i j))
555     ('double-float
556     (gsl-vector-swap-elements (gsl-vec-ptr v) i j))
557     ('complex-single-float
558     (gsl-vector-complex-float-swap-elements (gsl-vec-ptr v) i j))
559     ('complex-double-float
560     (gsl-vector-complex-swap-elements (gsl-vec-ptr v) i j)))))
561     (values v status)))
562    
563    
564     (defun reverse-vector (v)
565     (declare (gsl-vec v))
566     (let ((status
567     (ecase (gsl-vec-element-type v)
568     ('integer
569     (gsl-vector-int-reverse (gsl-vec-ptr v)))
570     ('single-float
571     (gsl-vector-float-reverse (gsl-vec-ptr v)))
572     ('double-float
573     (gsl-vector-reverse (gsl-vec-ptr v)))
574     ('complex-single-float
575     (gsl-vector-complex-float-reverse (gsl-vec-ptr v)))
576     ('complex-double-float
577     (gsl-vector-complex-reverse (gsl-vec-ptr v))))))
578     (values v status)))
579    
580    
581     (defun add (va vb)
582     (declare (gsl-vec va) (gsl-vec vb))
583     (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
584     (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
585     (let ((status
586     (ecase (gsl-vec-element-type va)
587     ('integer
588     (gsl-vector-int-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))
589     ('single-float
590     (gsl-vector-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))
591     ('double-float
592     (gsl-vector-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))
593     ('complex-single-float
594     (gsl-vector-complex-float-add (gsl-vec-ptr va) (gsl-vec-ptr vb)))
595     ('complex-double-float
596     (gsl-vector-complex-add (gsl-vec-ptr va) (gsl-vec-ptr vb))))))
597     (values va status)))
598    
599    
600     (defun sub (va vb)
601     (declare (gsl-vec va) (gsl-vec vb))
602     (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
603     (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
604     (let ((status
605     (ecase (gsl-vec-element-type va)
606     ('integer
607     (gsl-vector-int-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))
608     ('single-float
609     (gsl-vector-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))
610     ('double-float
611     (gsl-vector-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))
612     ('complex-single-float
613     (gsl-vector-complex-float-sub (gsl-vec-ptr va) (gsl-vec-ptr vb)))
614     ('complex-double-float
615     (gsl-vector-complex-sub (gsl-vec-ptr va) (gsl-vec-ptr vb))))))
616     (values va status)))
617    
618     (defun mul (va vb)
619     (declare (gsl-vec va) (gsl-vec vb))
620     (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
621     (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
622     (let ((status
623     (ecase (gsl-vec-element-type va)
624     ('integer
625     (gsl-vector-int-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))
626     ('single-float
627     (gsl-vector-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))
628     ('double-float
629     (gsl-vector-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))
630     ('complex-single-float
631     (gsl-vector-complex-float-mul (gsl-vec-ptr va) (gsl-vec-ptr vb)))
632     ('complex-double-float
633     (gsl-vector-complex-mul (gsl-vec-ptr va) (gsl-vec-ptr vb))))))
634     (values va status)))
635    
636    
637     (defun div (va vb)
638     (declare (gsl-vec va) (gsl-vec vb))
639     (assert (eq (gsl-vec-element-type va) (gsl-vec-element-type vb)))
640     (assert (= (gsl-vec-size va) (gsl-vec-size vb)))
641     (let ((status
642     (ecase (gsl-vec-element-type va)
643     ('integer
644     (gsl-vector-int-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))
645     ('single-float
646     (gsl-vector-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))
647     ('double-float
648     (gsl-vector-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))
649     ('complex-single-float
650     (gsl-vector-complex-float-div (gsl-vec-ptr va) (gsl-vec-ptr vb)))
651     ('complex-double-float
652     (gsl-vector-complex-div (gsl-vec-ptr va) (gsl-vec-ptr vb))))))
653     (values va status)))
654    
655    
656     (defun scale (v x)
657     (declare (gsl-vec v))
658     (assert (eq (gsl-vec-element-type v) (type-of x)))
659     (let ((status
660     (ecase (gsl-vec-element-type v)
661     ('integer
662     (gsl-vector-int-scale (gsl-vec-ptr v) x))
663     ('single-float
664     (gsl-vector-float-scale (gsl-vec-ptr v) x))
665     ('double-float
666     (gsl-vector-scale (gsl-vec-ptr v) x))
667     ('complex-single-float
668     (gsl-vector-complex-float-scale (gsl-vec-ptr v) x))
669     ('complex-double-float
670     (gsl-vector-complex-scale (gsl-vec-ptr v) x)))))
671     (values v status)))
672    
673    
674     (defun add-constant (v x)
675     (declare (gsl-vec v))
676     (assert (eq (gsl-vec-element-type v) (type-of x)))
677     (let ((status
678     (ecase (gsl-vec-element-type v)
679     ('integer
680     (gsl-vector-int-add-constant (gsl-vec-ptr v) x))
681     ('single-float
682     (gsl-vector-float-add-constant (gsl-vec-ptr v) x))
683     ('double-float
684     (gsl-vector-add-constant (gsl-vec-ptr v) x))
685     ('complex-single-float
686     (gsl-vector-complex-float-add-constant (gsl-vec-ptr v) x))
687     ('complex-double-float
688     (gsl-vector-complex-add-constant (gsl-vec-ptr v) x)))))
689     (values v status)))
690    
691    
692     (defun max-value (v)
693     (declare (gsl-vec v))
694     (ecase (gsl-vec-element-type v)
695     ('integer
696     (gsl-vector-int-max (gsl-vec-ptr v)))
697     ('single-float
698     (gsl-vector-float-max (gsl-vec-ptr v)))
699     ('double-float
700     (gsl-vector-max (gsl-vec-ptr v)))
701     ('complex-single-float
702     (gsl-vector-complex-float-max (gsl-vec-ptr v)))
703     ('complex-double-float
704     (gsl-vector-complex-max (gsl-vec-ptr v)))))
705    
706    
707     (defun min-value (v)
708     (declare (gsl-vec v))
709     (ecase (gsl-vec-element-type v)
710     ('integer
711     (gsl-vector-int-min (gsl-vec-ptr v)))
712     ('single-float
713     (gsl-vector-float-min (gsl-vec-ptr v)))
714     ('double-float
715     (gsl-vector-min (gsl-vec-ptr v)))
716     ('complex-single-float
717     (gsl-vector-complex-float-min (gsl-vec-ptr v)))
718     ('complex-double-float
719     (gsl-vector-complex-min (gsl-vec-ptr v)))))
720    
721    
722     (defun max-index (v)
723     (declare (gsl-vec v))
724     (ecase (gsl-vec-element-type v)
725     ('integer
726     (gsl-vector-int-max-index (gsl-vec-ptr v)))
727     ('single-float
728     (gsl-vector-float-max-index (gsl-vec-ptr v)))
729     ('double-float
730     (gsl-vector-max-index (gsl-vec-ptr v)))
731     ('complex-single-float
732     (gsl-vector-complex-float-max-index (gsl-vec-ptr v)))
733     ('complex-double-float
734     (gsl-vector-complex-max-index (gsl-vec-ptr v)))))
735    
736    
737     (defun max-index (v)
738     (declare (gsl-vec v))
739     (ecase (gsl-vec-element-type v)
740     ('integer
741     (gsl-vector-int-min-index (gsl-vec-ptr v)))
742     ('single-float
743     (gsl-vector-float-min-index (gsl-vec-ptr v)))
744     ('double-float
745     (gsl-vector-min-index (gsl-vec-ptr v)))
746     ('complex-single-float
747     (gsl-vector-complex-float-min-index (gsl-vec-ptr v)))
748     ('complex-double-float
749     (gsl-vector-complex-min-index (gsl-vec-ptr v)))))
750    
751    
752     (defun min-max-indicies (v)
753     (declare (gsl-vec v))
754     (let ((min-ptr (uffi:allocate-foreign-object 'size-t))
755     (max-ptr (uffi:allocate-foreign-object 'size-t)))
756     (ecase (gsl-vec-element-type v)
757     ('integer
758     (gsl-vector-int-minmax-index (gsl-vec-ptr v)))
759     ('single-float
760     (gsl-vector-float-minmax-index (gsl-vec-ptr v)))
761     ('double-float
762     (gsl-vector-minmax-index (gsl-vec-ptr v)))
763     ('complex-single-float
764     (gsl-vector-complex-float-minmax-index (gsl-vec-ptr v)))
765     ('complex-double-float
766     (gsl-vector-complex-minmax-index (gsl-vec-ptr v))))
767     (prog1
768     (list (uffi:deref-pointer 'size-t min-ptr)
769     (uffi:deref-pointer 'size-t max-ptr))
770     (uffi:free-foreign-object min-ptr)
771     (uffi:free-foreign-object max-ptr))))
772    
773    
774     (defun min-max-values (v)
775     (declare (gsl-vec v))
776     (destructuring-bind (min-index max-index)
777     (min-max-indicies v)
778     (list (get-element v min-index)
779     (get-element v max-index))))
780    
781    
782     (defun isnull (v)
783     (declare (gsl-vec v))
784     (1/0->t/nil (ecase (gsl-vec-element-type v)
785     ('integer
786     (gsl-vector-int-isnull (gsl-vec-ptr v)))
787     ('single-float
788     (gsl-vector-float-isnull (gsl-vec-ptr v)))
789     ('double-float
790     (gsl-vector-isnull (gsl-vec-ptr v)))
791     ('complex-single-float
792     (gsl-vector-complex-float-isnull (gsl-vec-ptr v)))
793     ('complex-double-float
794     (gsl-vector-complex-isnull (gsl-vec-ptr v))))))
795    
796     ;; Function: gsl_vector_view gsl_vector_complex_real (gsl_vector_complex *v)
797     ;; Function: gsl_vector_view gsl_vector_complex_imag (gsl_vector_complex *v)
798    
799     ;; ----------------------------------------------------------------------
800     ;; Functions that I don't think need binding.
801     ;;
802    
803     ;; Function: gsl_vector * gsl_vector_calloc (size_t n)
804    
805     ;; Function: double * gsl_vector_ptr (gsl_vector * v, size_t i)
806     ;; Function: const double * gsl_vector_const_ptr (const gsl_vector * v, size_t i)
807    
808     ;; Function: gsl_vector_const_view gsl_vector_const_subvector (const gsl_vector * v, size_t offset, size_t n)
809    
810     ;; Function: gsl_vector_const_view gsl_vector_const_subvector_with_stride (const gsl_vector * v, size_t offset, size_t stride, size_t n)
811    
812     ;; Function: gsl_vector_const_view gsl_vector_complex_const_real (const gsl_vector_complex *v)
813    
814     ;; Function: gsl_vector_const_view gsl_vector_complex_const_imag (const gsl_vector_complex *v)
815    
816     ;; Function: gsl_vector_view gsl_vector_view_array_with_stride (double * base, size_t stride, size_t n)
817     ;; Function: gsl_vector_const_view gsl_vector_const_view_array_with_stride (const double * base, size_t stride, size_t n)

  ViewVC Help
Powered by ViewVC 1.1.5