Commit 259c1457 authored by lhealy's avatar lhealy Committed by Liam Healy

The classes/types in the different contexts are now gathered together

in one place, in *type-names* for the types and in *data-class-name*
for data classes, populated by #'add-data-class.  Both defdata and
defmfun-all use the table and so mapping between various names is
consistent.  The data class names are now different, *-double-float
and *-single-float replaces *-double and *-single.  The regression
tests give the same results as before.


git-svn-id: svn+ssh://common-lisp.net/project/gsll/svn/trunk@34 af03a46b-e846-0410-96e5-d5653c316fd0
parent c03a48f8
;; Basis splines.
;; Liam Healy 2008-02-18 14:43:20EST basis-splines.lisp
;; Time-stamp: <2008-02-23 19:36:35EST basis-splines.lisp>
;; Time-stamp: <2008-03-09 19:30:56EDT basis-splines.lisp>
;; $Id$
(in-package :gsl)
......@@ -74,13 +74,13 @@
(bw (basis-spline order nbreak))
(mw (fit-workspace ndata ncoeffs))
(rng (random-number-generator *mt19937* 0))
(B (vector-double ncoeffs))
(c (vector-double ncoeffs))
(cov (matrix-double ncoeffs ncoeffs))
(w (vector-double ndata))
(x (vector-double ndata))
(y (vector-double ndata))
(Xmatrix (matrix-double ndata ncoeffs))
(B (vector-double-float ncoeffs))
(c (vector-double-float ncoeffs))
(cov (matrix-double-float ncoeffs ncoeffs))
(w (vector-double-float ndata))
(x (vector-double-float ndata))
(y (vector-double-float ndata))
(Xmatrix (matrix-double-float ndata ncoeffs))
(sigma 0.1d0))
;; The data to be fitted.
(dotimes (i ndata)
......
;; Blocks of data
;; Liam Healy, Mon Mar 27 2006 - 12:28
;; Time-stamp: <2008-02-17 09:18:05EST block.lisp>
;; Time-stamp: <2008-03-09 18:54:10EDT block.lisp>
;; $Id$
(in-package :gsl)
......@@ -10,7 +10,12 @@
(size size)
(data :pointer))
(defdata "block" block-double double-float)
(defdata "block_float" block-single single-float)
(defdata "block_complex" block-complex complex)
(defdata "block_int" block-fixnum fixnum)
(add-data-class block double-float block-double-float block "block")
(add-data-class block single-float block-single-float block "block")
(add-data-class block fixnum block-fixnum block "block")
(add-data-class block complex block-complex block "block")
(defdata block double-float)
(defdata block single-float)
(defdata block fixnum)
(defdata block complex)
;; Combinations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2008-02-23 18:49:21EST combination.lisp>
;; Time-stamp: <2008-03-09 22:07:29EDT combination.lisp>
;; $Id$
(in-package :gsl)
......@@ -16,16 +16,17 @@
(data :pointer))
;;; Allocation, freeing, reading and writing
(defdata "combination" combination unsigned-byte gsl-data 2)
(add-data-class combination fixnum combination gsl-data "combination")
(defdata combination fixnum 2 "")
(defmethod gsl-array ((object gsl-combination))
(defmethod gsl-array ((object combination))
(foreign-slot-value (pointer object) 'gsl-combination-c 'data))
;;;;****************************************************************************
;;;; Getting values
;;;;****************************************************************************
(defmfun maref ((combination gsl-combination) &rest indices)
(defmfun maref ((combination combination) &rest indices)
"gsl_combination_get"
(((pointer combination) :pointer) ((first indices) size))
:type :method
......@@ -33,7 +34,7 @@
:documentation ; FDL
"The ith element of the combination.")
(defmethod data ((object gsl-combination) &optional sequence)
(defmethod data ((object combination) &optional sequence)
(let ((seq (or sequence
(make-sequence 'list (combination-size object)))))
(loop for i from 0
......@@ -101,7 +102,7 @@
"A pointer to the array of elements in the combination.")
|#
(defmfun data-valid ((combination gsl-combination))
(defmfun data-valid ((combination combination))
"gsl_combination_valid"
(((pointer combination) :pointer))
:type :method
......
;; Using GSL bulk data (vectors, matrices, etc.) storage.
;; Liam Healy, Sun Mar 26 2006 - 16:32
;; Time-stamp: <2008-02-23 18:57:18EST data.lisp>
;; Time-stamp: <2008-03-10 21:15:40EDT data.lisp>
;; $Id$
(in-package :gsl)
......@@ -36,10 +36,12 @@
(defmethod print-object ((object gsl-data) stream)
(print-data-object object *print-array* stream))
(defparameter *print-data-contents* t)
(defun print-data-object (object contents stream)
"Print the data object to the stream, possibly showing contents."
(print-unreadable-object (object stream :type t :identity t)
(when contents
(when (and contents *print-data-contents*)
(princ (data object) stream))))
(defgeneric gsl-array (object)
......@@ -53,7 +55,7 @@
"The second dimension of the object."
(second (storage-size object)))
(defgeneric cl-base-type (object)
(defgeneric cl-elt-type (object)
(:documentation "The CL type of an element."))
;;; Accessing elements
......@@ -96,13 +98,6 @@
;;; (args (loop for i below dimensions collect (intern (format nil "I~d" i))))
;;; (mapcar (lambda (v) `(,v size)) args)
(defparameter *data-name-alist*
'((FIXNUM . "_int")
(SINGLE . "_float")
(DOUBLE . "")
;;(LONG-DOUBLE . "_long_double")
(COMPLEX . "_complex")))
(defmacro data-go (type matrixp)
"Define the letm function for data types."
(if matrixp ; Matrix (two indices)
......@@ -151,96 +146,108 @@
(lambda (symb) `(unless (numberp ,argsymb) (setf (data ,symb) ,argsymb)))
(lambda () (list argsymb size-or-initial)))))))))
(defmacro defdata
(c-string cl-symbol cl-base-type
&optional (superclass 'gsl-data) (dimensions 1))
(defparameter *data-class-name* nil
"A list classes, each consisting of a list
superclass, CL element type, class, GSL splice name.")
(defmacro add-data-class (category element-type class superclass GSL-string)
`(eval-when (:compile-toplevel :load-toplevel :execute)
(pushnew (list ',category ',element-type ',class ',superclass ',GSL-string)
*data-class-name*
:test #'equal)))
(defun data-type-lookup (category element-type)
(find (list category element-type)
*data-class-name*
:key (lambda (l) (subseq l 0 2))
:test #'equal))
(defun data-class-name (category element-type)
(third (data-type-lookup category element-type)))
(defun data-superclass-name (category element-type)
(fourth (data-type-lookup category element-type)))
(defun data-gsl-string (category element-type)
(fifth (data-type-lookup category element-type)))
(defmacro defdata (category cl-elt-type &optional (dimensions 1) splice-name)
"For the type named in the string,
define the allocator (gsl-*-alloc), zero allocator (gsl-*-calloc),
freeing (gsl-*-free), binary writing (binary-*-write) and
reading (binary-*-read), formatted writing (write-*-formatted)
and reading (read-*-formatted) functions."
;; Need to remove duplicates from *data-name-alist*
(flet ((gsl-name (function-name)
(format nil "gsl_~a_~a" c-string function-name)))
(format nil "gsl_~a~a_~a"
(data-gsl-string category cl-elt-type)
(or splice-name
(lookup-splice-name cl-elt-type)) function-name)))
(let* ((cargs (loop for i below dimensions
collect `((nth ,i (storage-size object)) size)))
(object-name (make-symbol-from-strings *gsl-prefix* cl-symbol)))
(class-name (data-class-name category cl-elt-type)))
`(progn
(defclass ,object-name (,superclass)
((cl-base-type :initform ',cl-base-type :reader cl-base-type
:allocation :class)))
(data-go ,cl-symbol
,(or (member superclass '(gsl-matrix)) (member object-name '(gsl-combination))))
(defmfun alloc ((object ,object-name))
(defclass ,class-name (,(data-superclass-name category cl-elt-type))
((cl-elt-type :initform ',cl-elt-type :reader cl-elt-type
:allocation :class)))
(data-go ,class-name
,(or (member category '(matrix combination))))
(defmfun alloc ((object ,class-name))
,(gsl-name "alloc") ,cargs
:type :method
:c-return (cr :pointer)
:return ((assign-pointer object cr)))
(defmfun calloc ((object ,object-name))
(defmfun calloc ((object ,class-name))
,(gsl-name "calloc") ,cargs
:type :method
:c-return (cr :pointer)
:return ((assign-pointer object cr)))
(defmfun free ((object ,object-name))
(defmfun free ((object ,class-name))
,(gsl-name "free") (((pointer object) :pointer))
:type :method
:c-return :void)
(defmfun write-binary ((object ,object-name) stream)
(defmfun write-binary ((object ,class-name) stream)
,(gsl-name "fwrite") ((stream :pointer) ((pointer object) :pointer))
:type :method)
(defmfun read-binary ((object ,object-name) stream)
(defmfun read-binary ((object ,class-name) stream)
,(gsl-name "fread") ((stream :pointer) ((pointer object) :pointer))
:type :method)
(defmfun write-formatted ((object ,object-name) stream format)
(defmfun write-formatted ((object ,class-name) stream format)
,(gsl-name "fprintf")
((stream :pointer) ((pointer object) :pointer) (format :string))
:type :method)
(defmfun read-formatted ((object ,object-name) stream format)
(defmfun read-formatted ((object ,class-name) stream format)
,(gsl-name "fscanf")
((stream :pointer) ((pointer object) :pointer) (format :string))
:type :method)))))
(defun splice-name (base-name keyword symbol)
"Make a new C name for a data function from a base name."
(let* ((insert (+ (search keyword base-name) (length keyword))))
(concatenate 'string
(subseq base-name 0 insert)
(rest (assoc symbol *data-name-alist*))
(subseq base-name insert))))
;;; (splice-name "gsl_vector_get" "vector" 'vector-fixnum)
;;; "gsl_vector_int_get"
;;; (make-symbol-from-strings *gsl-prefix* 'vector-fixnum)
;;; GSL-VECTOR-FIXNUM
(defun defmfun-all (types ctypes string general-class args)
(defun defmfun-all (category cl-types args &optional key-string)
"A defmfun for each of the declared data types."
`(progn
,@(loop for type in types
for ctype in ctypes
collect
`(defmfun ,(first args)
;; Set the class name for the arglist
,(mapcar
(lambda (x)
(if (and (listp x) (eq (second x) general-class))
(list (first x)
(make-symbol-from-strings general-class type))
x))
(second args))
;; Create the correct GSL C library function name
,(splice-name (third args) string type)
,(mapcar
(lambda (x)
(if (eq (st-type x) :c-base-type)
(list (st-symbol x) ctype)
x))
(fourth args))
,@(let ((restargs (copy-list (nthcdr 4 args))))
(when (eq (getf restargs :c-return) :c-base-type)
(setf (getf restargs :c-return) ctype))
(setf (getf restargs :type) :method)
restargs)))))
(let ((categories (if (listp category) category (list category))))
`(progn
,@(loop for type in cl-types
for ctype = (lookup-C-type type)
collect
`(defmfun ,(first args)
;; Set the class name for the arglist
,(mapcar
(lambda (x)
(if (and (listp x) (member (second x) categories))
(list (first x)
(data-class-name (second x) type))
x))
(second args))
;; Create the correct GSL C library function name
,(splice-name
(third args)
;; Use key-string to override the lookup of the category.
(or key-string (data-gsl-string (first categories) type))
type)
,(mapcar
(lambda (x)
(if (eq (st-type x) :c-base-type)
(list (st-symbol x) ctype)
x))
(fourth args))
,@(let ((restargs (copy-list (nthcdr 4 args))))
(when (eq (getf restargs :c-return) :c-base-type)
(setf (getf restargs :c-return) ctype))
(setf (getf restargs :type) :method)
restargs))))))
;;;;****************************************************************************
;;;; Making data objects and initializing storage
......@@ -263,10 +270,7 @@
"Make the GSL data object, including the allocation of space.
The user is responsible for calling #'free to free the foreign
memory when done."
(let ((obj
(make-instance
(make-symbol-from-strings *gsl-prefix* type)
:storage-size size)))
(let ((obj (make-instance type :storage-size size)))
(if zero (calloc obj) (alloc obj))
obj))
......@@ -296,7 +300,7 @@
(list (make-list total-size))
((nil vector)
(make-array (list total-size)
:element-type (cl-base-type object)))
:element-type (cl-elt-type object)))
(t sequence))))
(loop for i from 0
below (min (length seq) total-size)
......
This diff is collapsed.
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2008-02-23 18:49:22EST permutation.lisp>
;; Time-stamp: <2008-03-09 21:52:16EDT permutation.lisp>
;; $Id$
(in-package :gsl)
......@@ -14,17 +14,17 @@
(size size)
(data :pointer))
;;; Allocation, freeing, reading and writing
(defdata "permutation" permutation unsigned-byte)
(add-data-class permutation fixnum permutation gsl-data "permutation")
(defdata permutation fixnum 1 "")
(defmethod gsl-array ((object gsl-permutation))
(defmethod gsl-array ((object permutation))
(foreign-slot-value (pointer object) 'gsl-permutation-c 'data))
;;;;****************************************************************************
;;;; Getting values
;;;;****************************************************************************
(defmfun maref ((permutation gsl-permutation) &rest indices)
(defmfun maref ((permutation permutation) &rest indices)
"gsl_permutation_get"
(((pointer permutation) :pointer) ((first indices) size))
:type :method
......@@ -35,7 +35,7 @@
;;;; Setting values
;;;;****************************************************************************
(defmfun set-identity ((permutation gsl-permutation))
(defmfun set-identity ((permutation permutation))
"gsl_permutation_init"
(((pointer permutation) :pointer))
:type :method
......@@ -44,7 +44,7 @@
"Initialize the permutation p to the identity, i.e.
(0,1,2,...,n-1).")
(defmfun copy ((destination gsl-permutation) (source gsl-permutation))
(defmfun copy ((destination permutation) (source permutation))
"gsl_permutation_memcpy"
(((pointer destination) gsl-permutation-c)
((pointer source) gsl-permutation-c))
......@@ -54,7 +54,7 @@
"Copy the elements of the permutation source into the
permutation destination. The two permutations must have the same size.")
(defmfun swap-elements ((p gsl-permutation) i j)
(defmfun swap-elements ((p permutation) i j)
"gsl_permutation_swap"
(((pointer p) gsl-permutation-c) (i size) (j size))
:type :method
......@@ -81,7 +81,7 @@
"A pointer to the array of elements in the
permutation p.")
(defmfun data-valid ((permutation gsl-permutation))
(defmfun data-valid ((permutation permutation))
"gsl_permutation_valid"
(((pointer permutation) :pointer))
:type :method
......@@ -162,7 +162,7 @@
identity matrix. The permutation p and the vector v must
have the same length."))
(defmfun-vdsfc permute-vector (p (v gsl-vector))
(defmfun-vdsfc permute-vector (p (v vector))
"gsl_permute_vector"
(((pointer p) gsl-permutation-c) ((pointer v) gsl-vector-c))
:invalidate (v))
......@@ -178,7 +178,7 @@
the p_j-th column of the identity matrix. The permutation p
and the vector v must have the same length."))
(defmfun-vdsfc permute-vector-inverse (p (v gsl-vector))
(defmfun-vdsfc permute-vector-inverse (p (v vector))
"gsl_permute_vector_inverse"
(((pointer p) gsl-permutation-c) ((pointer v) gsl-vector-c))
:invalidate (v))
......
This diff is collapsed.
......@@ -62,17 +62,18 @@ href="http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm#letST">l
with the additional feature that if the init-form is one of GSL objects
<pre>
acceleration basis-spline block-complex block-double block-fixnum
block-single chebyshev combination complex-workspace discrete-random
eigen-herm eigen-hermv eigen-symm eigen-symmv fdfsolver fit-workspace
fminimizer fsolver hankel histogram integration-workspace
interpolation levin levin-truncated matrix-complex matrix-double
matrix-fixnum matrix-single mfdfminimizer mfdfsolver mfminimizer
mfsolver monte-carlo-miser monte-carlo-plain monte-carlo-vegas
acceleration basis-spline block-complex block-double-float block-fixnum
block-single-float chebyshev combination complex-workspace
discrete-random eigen-herm eigen-hermv eigen-symm eigen-symmv
fdfsolver fit-workspace fminimizer fsolver hankel histogram
integration-workspace interpolation levin levin-truncated
matrix-complex matrix-double-float matrix-fixnum
matrix-single-float mfdfminimizer mfdfsolver mfminimizer mfsolver
monte-carlo-miser monte-carlo-plain monte-carlo-vegas
nonlinear-fdffit nonlinear-ffit permutation
quasi-random-number-generator random-number-generator spline
vector-complex vector-double vector-fixnum vector-single wavelet
wavelet-workspace
vector-complex vector-double-float vector-fixnum
vector-single-float wavelet wavelet-workspace
</pre>
the appropriate object will be allocated and bound to the variable,
optionally set, and then freed when the body of the let is exited.
......@@ -95,7 +96,7 @@ let binding.
can be done within the <code>letm</code> by giving the Lisp value as
the first argument after the type, for example
<pre>
(letm ((vec (vector-double #(-3.21d0 1.0d0 12.8d0))))
(letm ((vec (vector-double-float #(-3.21d0 1.0d0 12.8d0))))
(data vec))
</pre>
Individual elements of data may be accessed with <code>maref</code>,
......@@ -154,7 +155,7 @@ gamma-randist, negative-binomial.
<address><a href="mailto:gsll-devel@common-lisp.net">Liam Healy</a></address>
<!-- hhmts start -->
<small>
Time-stamp: <2008-03-08 11:07:51EST documentation.html>
Time-stamp: <2008-03-09 22:21:24EDT documentation.html>
</small>
<!-- hhmts end -->
</div>
......
;; Eigenvectors and eigenvalues
;; Liam Healy, Sun May 21 2006 - 19:52
;; Time-stamp: <2008-02-17 11:32:46EST eigensystems.lisp>
;; Time-stamp: <2008-03-10 21:20:59EDT eigensystems.lisp>
;; $Id$
(in-package :gsl)
......@@ -165,14 +165,13 @@
:value-descending, :absolute-ascending, :absolute-descending."))
(defmfun sort-eigenvalues-eigenvectors
((eval gsl-vector-double) evec sort-type)
((eval vector-double-float) evec sort-type)
"gsl_eigen_symmv_sort"
((eval gsl-vector-c) (evec gsl-matrix-c) (sort-type eigen-sort-type))
:type :method
:invalidate (eval evec))
(defmfun sort-eigenvalues-eigenvectors
((eval gsl-vector-complex) evec sort-type)
(defmfun sort-eigenvalues-eigenvectors ((eval vector-complex) evec sort-type)
"gsl_eigen_hermv_sort"
((eval gsl-vector-c) (evec gsl-matrix-c) (sort-type eigen-sort-type))
:type :method
......@@ -183,10 +182,10 @@
;;;;****************************************************************************
(defun eigenvalue-eigenvectors-example ()
(letm ((evecs (matrix-double 3 3))
(evals (vector-double 3))
(letm ((evecs (matrix-double-float 3 3))
(evals (vector-double-float 3))
(ws (eigen-symmv 3))
(mat (matrix-double
(mat (matrix-double-float
#2A((20.0d0 -10.0d0 0.0d0)
(-10.0d0 30.0d0 0.0d0)
(0.0d0 0.0d0 40.0d0)))))
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2008-02-18 16:59:30EST gsll.asd>
;; Time-stamp: <2008-03-09 22:13:36EDT gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -15,7 +15,6 @@
:components
((:file "init")
(:file "conditions" :depends-on (init))
(:file "utility" :depends-on (init))
(:file "gsl-objects" :depends-on (init))
(:file "number-conversion" :depends-on (init))
(:file "interface" :depends-on (init conditions number-conversion))
......@@ -165,7 +164,7 @@
(:file "types")
(:file "lookup")
(:file "evaluation")
(:file "spline-example")))
(:file "spline-example" :depends-on (types))))
(:file "numerical-differentiation" :depends-on (init))
(:file "chebyshev" :depends-on (init))
(:file "series-acceleration" :depends-on (init))
......
;; Load GSL
;; Liam Healy Sat Mar 4 2006 - 18:53
;; Time-stamp: <2008-02-25 19:31:49EST init.lisp>
;; Time-stamp: <2008-03-09 12:30:38EDT init.lisp>
;; $Id$
(defpackage gsll
......@@ -20,17 +20,3 @@
(t (:default "libgsl")))
(cffi:use-foreign-library libgsl)
;;; The following define :size, from cffi-unix which became cffi-net,
;;; which is apparently turning into something even bigger and more
;;; irrelevant. All we need is the definition of :size. This is
;;; not in the keyword package to suppress warnings from CFFI.
(cffi:defctype uint32 :unsigned-int)
(cffi:defctype uint64 :unsigned-long)
(cffi:defctype gsll::size
#-cffi-features:no-long-long uint64
#+cffi-features:no-long-long
#.(progn (cerror "Use uint32 instead."
"This platform does not support long long types.")
uint32))
;; Conversion of numbers C->CL
;; Liam Healy, Sun May 28 2006 - 22:04
;; Time-stamp: <2008-02-17 18:54:32EST number-conversion.lisp>
;; Time-stamp: <2008-03-09 14:17:34EDT number-conversion.lisp>
;; $Id$
(in-package :gsl)
......@@ -70,3 +70,58 @@
(err ,(st-symbol decl) 'sf-result-e10)))
(t `((,(cl-convert-function (st-type decl)) ,(st-symbol decl))))))
;;;;****************************************************************************
;;;; Types
;;;;****************************************************************************
;;; CL type definitions:
(deftype unsigned-byte8 () '(unsigned-byte 8))
(deftype unsigned-byte16 () '(unsigned-byte 16))
(deftype unsigned-byte32 () '(unsigned-byte 32))
(deftype unsigned-byte64 () '(unsigned-byte 64))
;;; C type definitions from cffi-net/unixint.cffi.lisp:
(cffi:defctype uint8 :unsigned-char)
(cffi:defctype uint16 :unsigned-short)
(cffi:defctype uint32 :unsigned-int)
(cffi:defctype uint64 :unsigned-long)
(cffi:defctype int8 :char)
(cffi:defctype int16 :short)
(cffi:defctype int32 :int)
(cffi:defctype int64 :long)
#-cffi-features:no-long-long
(cffi:defctype size uint64)
#+cffi-features:no-long-long
(progn (cerror "Use :uint32 instead." "This platform does not support long long types.")
(cffi:defctype size uint32))
;;;(deftype unsigned-fixnum () `(integer 0 ,most-positive-fixnum))
(defparameter *type-names*
'(
(fixnum :int "_int")
(unsigned-fixnum :unsigned-int "_uint")
(single-float :float "_float")
(double-float :double "")
;;(long-double :long "_long_double")
(complex gsl-complex "_complex")
(t nil ""))
"A list of type name mappings, each being a list
Lisp type, C type as CFFI understands it, and GSL
splice string.")
(defun lookup-splice-name (cl-type)
(third (find cl-type *type-names* :key #'first)))
(defun lookup-C-type (cl-type)
(second (find cl-type *type-names* :key #'first)))
(defun splice-name (base-name keyword symbol)
"Make a new C name for a data function from a base name."
(let* ((insert (+ (search keyword base-name) (length keyword))))
(concatenate 'string
(subseq base-name 0 insert)
(lookup-splice-name symbol)
(subseq base-name insert))))
;; Utility definitions
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2008-03-02 21:43:01EST utility.lisp>
;; $Id$
(in-package :gsl)
(defun make-symbol-from-strings (&rest strings)
"Construct a symbol by concatenating words with hyphens."
(intern (format nil "~{~:@(~a~)~^-~}" (mapcar #'string strings)) :gsl))
(defparameter *gsl-prefix* 'gsl)
;; Example spline
;; Liam Healy, Sat Nov 10 2007 - 21:18
;; Time-stamp: <2008-02-03 22:59:29EST spline-example.lisp>
;; Time-stamp: <2008-03-09 19:21:47EDT spline-example.lisp>
;; $Id$
(in-package :gsl)
......@@ -20,8 +20,8 @@
(multiple-value-bind (xarr yarr)
(spline-example-arrays)
(letm ((acc (acceleration))
(cxarr (vector-double xarr))
(cyarr (vector-double yarr))
(cxarr (vector-double-float xarr))
(cyarr (vector-double-float yarr))
(spline (spline *cubic-spline-interpolation* cxarr cyarr)))
(loop for xi from (aref xarr 0) below (aref xarr 9) by 0.01d0
collect (list xi (evaluate-spline spline xi acc))))))
This diff is collapsed.
;; BLAS level 2, Matrix-vector operations
;; Liam Healy, Wed Apr 26 2006 - 21:08
;; Time-stamp: <2008-02-17 10:36:36EST blas2.lisp>
;; Time-stamp: <2008-03-09 14:15:02EDT blas2.lisp>
;; $Id$
(in-package :gsl)
......@@ -105,47 +105,47 @@
(defmfun gemv
(TransA alpha
(A gsl-matrix-single) (x gsl-vector-single) beta (y gsl-vector-single))
(A matrix-single-float) (x vector-single-float) beta (y vector-single-float))
"gsl_blas_sgemv"
((transa cblas-transpose) (alpha :float) ((pointer A) gsl-matrix-c)
((pointer x) gsl-vector-c) (beta :float) ((pointer y) gsl-vector-c))
:type :method)
(defmfun trmv (uplo transa diag (A gsl-matrix-single) (x gsl-vector-single))
(defmfun trmv (uplo transa diag (A matrix-single-float) (x vector-single-float))
"gsl_blas_strmv"
((uplo cblas-uplo) (transa cblas-transpose) (diag cblas-diag)
((pointer A) gsl-matrix-c) ((pointer x) gsl-vector-c))
:type :method)
(defmfun trsv (uplo transa diag (A gsl-matrix-single) (x gsl-vector-single))
(defmfun trsv (uplo transa diag (A matrix-single-float) (x vector-single-float))
"gsl_blas_strsv"
((uplo cblas-uplo) (transa cblas-transpose) (diag cblas-diag)
((pointer A) gsl-matrix-c) ((pointer x) gsl-vector-c))
:type :method)
(defmfun symv
(uplo alpha (A gsl-matrix-single) (x gsl-vector-single)
beta (y gsl-vector-single))
(uplo alpha (A matrix-single-float) (x vector-single-float)
beta (y vector-single-float))
"gsl_blas_ssymv"
((uplo cblas-uplo) (alpha :float) ((pointer A) gsl-matrix-c)
((pointer x) gsl-vector-c) (beta :float) ((pointer y) gsl-vector-c))
:type :method)
(defmfun ger
(alpha (x gsl-vector-single) (y gsl-vector-single) (A gsl-matrix-single))
(alpha (x vector-single-float) (y vector-single-float) (A matrix-single-float))
"gsl_blas_sger"
((alpha :float) ((pointer x) gsl-vector-c)
((pointer y) gsl-vector-c) ((pointer A) gsl-matrix-c))
:type :method)
(defmfun syr (uplo alpha (x gsl-vector-single) (A gsl-matrix-single))
(defmfun syr (uplo alpha (x vector-single-float) (A matrix-single-float))
"gsl_blas_ssyr"
((uplo cblas-uplo) (alpha :float)
((pointer x) gsl-vector-c) ((pointer A) gsl-matrix-c))
:type :method)
(defmfun syr2
(uplo alpha (x gsl-vector-single) (y gsl-vector-single) (A gsl-matrix-single))
(uplo alpha (x vector-single-float) (y vector-single-float) (A matrix-single-float))
"gsl_blas_ssyr2"
((uplo cblas-uplo) (alpha :float)
((pointer x) gsl-vector-c) ((pointer y) gsl-vector-c)
......@@ -158,47 +158,47 @@
(defmfun gemv
(TransA alpha
(A gsl-matrix-double) (x gsl-vector-double) beta (y gsl-vector-double))
(A matrix-double-float) (x vector-double-float) beta (y vector-double-float))
"gsl_blas_dgemv"
((transa cblas-transpose) (alpha :double) ((pointer A) gsl-matrix-c)