Commit 217fea01 authored by Liam Healy's avatar Liam Healy

Port to ffa

Port new chapters to ffa.  Fix up BLAS.  Compiles; no testing.
parent 533b2126
;; Basis splines.
;; Liam Healy 2008-02-18 14:43:20EST basis-splines.lisp
;; Time-stamp: <2008-03-09 19:30:56EDT basis-splines.lisp>
;; Time-stamp: <2008-08-23 15:35:59EDT basis-splines.lisp>
;; $Id$
(in-package :gsl)
......@@ -12,7 +12,7 @@
(defmfun allocate-basis-spline (order number-of-breakpoints)
"gsl_bspline_alloc"
((order size) (number-of-breakpoints size))
((order sizet) (number-of-breakpoints sizet))
:c-return :pointer
:export nil
:index (letm basis-spline)
......@@ -51,7 +51,8 @@
(defmfun evaluate-bspline (x B workspace)
"gsl_bspline_eval"
((x :double) ((pointer B) :pointer) (workspace :pointer))
((x :double) ((mpointer B) :pointer) (workspace :pointer))
:outputs (B)
:documentation ; FDL
"Evaluate all B-spline basis functions at the position x and store
them in the GSL vector B, so that the ith element of B is B_i(x).
......@@ -76,11 +77,11 @@
(rng (random-number-generator *mt19937* 0))
(B (vector-double-float ncoeffs))
(c (vector-double-float ncoeffs))
(cov (matrix-double-float ncoeffs ncoeffs))
(cov (matrix-double-float (list ncoeffs ncoeffs)))
(w (vector-double-float ndata))
(x (vector-double-float ndata))
(y (vector-double-float ndata))
(Xmatrix (matrix-double-float ndata ncoeffs))
(Xmatrix (matrix-double-float (list ndata ncoeffs)))
(sigma 0.1d0))
;; The data to be fitted.
(dotimes (i ndata)
......
;; Chebyshev Approximations
;; Liam Healy Sat Nov 17 2007 - 20:36
;; Time-stamp: <2008-02-17 18:02:26EST chebyshev.lisp>
;; Time-stamp: <2008-08-23 11:27:10EDT chebyshev.lisp>
;; $Id$
(in-package :gsl)
......@@ -14,7 +14,7 @@
(defmfun allocate-chebyshev (order)
"gsl_cheb_alloc"
((order size))
((order sizet))
:c-return :pointer
:export nil
:index (letm chebyshev)
......@@ -51,47 +51,23 @@
;;; to use the functions that do return error (and ignore it if
;;; desired) in the form of #'evaluate-chebyshev.
(defmfun evaluate-chebyshev-noerror (chebyshev x)
"gsl_cheb_eval"
((chebyshev :pointer) (x :double))
(defmfun evaluate-chebyshev (chebyshev x &optional order)
("gsl_cheb_eval" "gsl_cheb_eval_n")
(((chebyshev :pointer) (x :double))
((chebyshev :pointer) (order sizet) (x :double)))
:c-return :double
:index evaluate-chebyshev
:export nil
:documentation ; FDL
"Evaluate the Chebyshev series at a point x.")
"Evaluate the Chebyshev series at a point x. If order is supplied,
evaluate to at most the given order.")
(defmfun evaluate-chebyshev-noerror-order (chebyshev x order)
"gsl_cheb_eval_n"
((chebyshev :pointer) (order size) (x :double))
:c-return :double
:index evaluate-chebyshev
:export nil
:documentation ; FDL
"Evaluate the Chebyshev series at a point x to at most the given order.")
(defmfun evaluate-chebyshev-full (chebyshev x)
"gsl_cheb_eval_err"
((chebyshev :pointer) (x :double) (result :double) (abserr :double))
:index evaluate-chebyshev
:export nil
(defmfun evaluate-chebyshev-error (chebyshev x &optional order)
("gsl_cheb_eval_err" "gsl_cheb_eval_n_err")
(((chebyshev :pointer) (x :double) (result :double) (abserr :double))
((chebyshev :pointer) (order sizet) (x :double) (result :double) (abserr :double)))
:documentation ; FDL
"Evaluate the Chebyshev series at a point x, returning result and
an estimate of its absolute error.")
(defmfun evaluate-chebyshev-order (chebyshev x order)
"gsl_cheb_eval_n_err"
((chebyshev :pointer) (order size) (x :double) (result :double) (abserr :double))
:index evaluate-chebyshev
:export nil
:documentation ; FDL
"Evaluate the Chebyshev series at a point x to at most the given order,
returning result and an estimate of its absolute error.")
(export 'evaluate-chebyshev)
(defun-optionals evaluate-chebyshev (chebyshev x &optional order)
-full -order ; FDL
"Evaluate the Chebyshev series at a point x to at most the given order,
returning result and an estimate of its absolute error.")
an estimate of its absolute error. If order is supplied,
evaluate to at most the given order.")
;;;;****************************************************************************
;;;; Derivatives and integrals
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2008-08-21 22:08:09EDT gsll.asd>
;; Time-stamp: <2008-08-23 19:39:32EDT gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -151,7 +151,6 @@
(:file "updating-accessing" :depends-on (histogram))
(:file "statistics" :depends-on (histogram))
(:file "operations" :depends-on (histogram))
(:file "read-write" :depends-on (histogram))
(:file "probability-distribution" :depends-on (histogram))
(:file "ntuple")))
(:file "monte-carlo" :depends-on (init data random))
......@@ -163,7 +162,6 @@
(:file "control")
(:file "evolution")
(:file "ode-example" :depends-on (ode-system stepping))))
#+no
(:module interpolation
:depends-on (init)
:components
......@@ -172,25 +170,19 @@
(:file "lookup")
(:file "evaluation")
(:file "spline-example" :depends-on (types))))
#+no
(:file "numerical-differentiation" :depends-on (init))
#+no
(:file "chebyshev" :depends-on (init))
#+no
(:file "series-acceleration" :depends-on (init))
#+no
(:file "wavelet" :depends-on (init data))
#+no
(:file "hankel" :depends-on (init data))
#+no
(:module solve-minimize-fit
:depends-on (init data random)
:components
((:file "roots-one")
(:file "minimization-one")
(:file "roots-multi" :depends-on (roots-one))
(:file "minimization-multi")
(:file "linear-least-squares")
(:file "nonlinear-least-squares")))
#+no
;(:file "roots-multi" :depends-on (roots-one))
;(:file "minimization-multi")
;(:file "linear-least-squares")
;(:file "nonlinear-least-squares")
))
(:file "basis-splines" :depends-on (init data))))
;; Discrete Hankel Transforms.
;; Liam Healy, Sat Dec 8 2007 - 16:50
;; Time-stamp: <2008-02-17 18:10:15EST hankel.lisp>
;; Time-stamp: <2008-08-23 11:48:13EDT hankel.lisp>
;; $Id$
(in-package :gsl)
......@@ -11,7 +11,7 @@
(defmfun allocate-hankel (size)
"gsl_dht_alloc"
((size size))
((size sizet))
:c-return :pointer
:export nil
:index (letm hankel)
......@@ -31,7 +31,7 @@
;; export it.
(defmfun new-hankel (size nu xmax)
"gsl_dht_new"
((size size) (nu :double) (xmax :double))
((size sizet) (nu :double) (xmax :double))
:c-return :pointer
:documentation ; FDL
"Allocate a Discrete Hankel transform object of size
......@@ -49,8 +49,8 @@
(defmfun apply-hankel (hankel array-in array-out)
"gsl_dht_apply"
((hankel :pointer) ((gsl-array array-in) :pointer)
((gsl-array array-out) :pointer))
((hankel :pointer) ((c-pointer array-in) :pointer)
((c-pointer array-out) :pointer))
:documentation ; FDL
"Apply the transform to the array array-in
whose size is equal to the size of the transform. The result is stored
......
;; Interpolation allocation, initialization, and freeing.
;; Liam Healy, Sun Nov 4 2007 - 17:24
;; Time-stamp: <2008-02-17 17:45:18EST interpolation.lisp>
;; Time-stamp: <2008-08-23 08:55:23EDT interpolation.lisp>
;; $Id$
(in-package :gsl)
......@@ -19,7 +19,7 @@
;;; Interpolation
(defmfun allocate-interpolation (type size)
"gsl_interp_alloc"
((type :pointer) (size size))
((type :pointer) (size sizet))
:c-return :pointer
:export nil
:index (letm interpolation)
......@@ -30,10 +30,11 @@
(defmfun initialize-interpolation (interpolation xa ya)
"gsl_interp_init"
((interpolation :pointer)
((gsl-array xa) :pointer) ((gsl-array ya) :pointer) ((dim0 xa) size))
((c-pointer xa) :pointer) ((c-pointer ya) :pointer) ((dim0 xa) sizet))
:inputs (xa ya)
:documentation ; FDL
"Initialize the interpolation object interp for the
data (xa,ya) where xa and ya are gsl-arrays. The interpolation object does not save
data (xa,ya) where xa and ya are vectors. The interpolation object does not save
the data arrays xa and ya and only stores the static state
computed from the data. The xa data array is always assumed to be
strictly ordered; the behavior for other arrangements is not defined.")
......@@ -58,7 +59,7 @@
;;; Spline
(defmfun allocate-spline (type size)
"gsl_spline_alloc"
((type :pointer) (size size))
((type :pointer) (size sizet))
:c-return :pointer
:documentation ; FDL
"Allocate an interpolation object of type for size data-points,
......@@ -67,10 +68,11 @@
(defmfun initialize-spline (interpolation xa ya)
"gsl_spline_init"
((interpolation :pointer)
((gsl-array xa) :pointer) ((gsl-array ya) :pointer) ((dim0 xa) size))
((c-pointer xa) :pointer) ((c-pointer ya) :pointer) ((dim0 xa) sizet))
:inputs (xa ya)
:documentation ; FDL
"Initialize the interpolation object interp for the
data (xa,ya) where xa and ya are gsl-arrays. The spline object saves
data (xa,ya) where xa and ya are c-pointers. The spline object saves
the data arrays xa and ya computed from the data.
The xa data array is always assumed to be
strictly ordered; the behavior for other arrangements is not defined.")
......
;; Index lookup and acceleration
;; Liam Healy, Sun Nov 4 2007 - 18:09
;; Time-stamp: <2008-02-17 17:50:25EST lookup.lisp>
;; Time-stamp: <2008-08-23 11:03:01EDT lookup.lisp>
;; $Id$
(in-package :gsl)
......@@ -9,8 +9,8 @@
(defmfun interpolation-search (x-array x low-index high-index)
"gsl_interp_bsearch"
((x-array :pointer) (x :double) (low-index size) (high-index size))
:c-return size
((x-array :pointer) (x :double) (low-index sizet) (high-index sizet))
:c-return sizet
:documentation ; FDL
"Find the index i of the array x-array such
that x-array[i] <= x < x-array[i+1]. The index is searched for
......@@ -31,7 +31,7 @@
(defmfun accelerated-interpolation-search (x-array x acceleration)
"gsl_interp_accel_find"
((acceleration :pointer) (x-array :pointer) (x :double))
:c-return size
:c-return sizet
:documentation ; FDL
"Search the data array x-array of size, using the given acceleration.
This is how lookups are performed during evaluation of an interpolation. The
......
;; BLAS level 1, Vector operations
;; Liam Healy, Wed Apr 26 2006 - 15:23
;; Time-stamp: <2008-08-03 23:24:43EDT blas1.lisp>
;; Time-stamp: <2008-08-23 14:34:44EDT blas1.lisp>
;; $Id$
(in-package :gsl)
......@@ -35,7 +35,7 @@
:documentation ; FDL
"The complex conjugate scalar product x^H y for the vectors.")
(defmfun 2norm ((vec1 vector) (vec2 vector))
(defmfun euclidean-norm ((vec1 vector) (vec2 vector))
("gsl_blas_" :component-float-type :type "nrm2")
(((mpointer vec1) :pointer) ((mpointer vec2) :pointer)
(result :component-float-type))
......@@ -190,7 +190,7 @@
(b (vector-single-float #(3.0f0 4.0f0 5.0f0))))
(dot a b))
(letm ((b (vector-single-float #(3.0f0 4.0f0 5.0f0))))
(norm b))
(euclidean-norm b))
(letm ((b (vector-single-float #(3.0f0 4.0f0 5.0f0))))
(asum b))
(letm ((b (vector-single-float #(3.0f0 5.0f0 4.0f0))))
......@@ -217,7 +217,7 @@
(b (vector-double-float #(3.0d0 4.0d0 5.0d0))))
(dot a b))
(letm ((b (vector-double-float #(3.0d0 4.0d0 5.0d0))))
(norm b))
(euclidean-norm b))
(letm ((b (vector-double-float #(3.0d0 4.0d0 5.0d0))))
(setf (data b) #(3.0d0 4.0d0 5.0d0))
(asum b))
......@@ -244,8 +244,6 @@
(rot a b (/ (sqrt 2.0d0)) (/ (sqrt 2.0d0)))
(data b)))
|#
(LISP-UNIT:DEFINE-TEST BLAS1-SINGLE
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 26.0f0)
......@@ -257,7 +255,7 @@
(LIST 7.071068f0)
(MULTIPLE-VALUE-LIST
(LETM ((B (VECTOR-SINGLE-FLOAT #(3.0f0 4.0f0 5.0f0))))
(NORM B))))
(EUCLIDEAN-NORM B))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 12.0f0)
(MULTIPLE-VALUE-LIST
......@@ -305,7 +303,7 @@
(LIST 7.0710678118654755d0)
(MULTIPLE-VALUE-LIST
(LETM ((B (VECTOR-DOUBLE-FLOAT #(3.0d0 4.0d0 5.0d0))))
(NORM B))))
(EUCLIDEAN-NORM B))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 12.0d0)
(MULTIPLE-VALUE-LIST
......@@ -349,5 +347,5 @@
(B (VECTOR-DOUBLE-FLOAT #(8.0d0 9.0d0))))
(ROT A B (/ (SQRT 2.0d0)) (/ (SQRT 2.0d0)))
(DATA B)))))
|#
;; BLAS level 3, Matrix-matrix operations
;; Liam Healy, Wed Apr 26 2006 - 21:08
;; Time-stamp: <2008-08-09 19:46:23EDT blas3.lisp>
;; Time-stamp: <2008-08-23 19:49:54EDT blas3.lisp>
;; $Id$
(in-package :gsl)
......@@ -36,7 +36,7 @@
("gsl_blas_" :type "symm")
((side cblas-side) (uplo cblas-uplo) (alpha :element-c-type)
(A :pointer) (B :pointer) (beta :element-c-type) (C :pointer))
:definition :generic
:definition :methods
:element-types :float-complex
:inputs (A B C)
:outputs (C)
......
;; Numerical integration
;; Liam Healy, Wed Jul 5 2006 - 23:14
;; Time-stamp: <2008-08-16 18:25:43EDT numerical-integration.lisp>
;; Time-stamp: <2008-08-23 19:18:03EDT numerical-integration.lisp>
;; $Id$
;;; To do: QAWS, QAWO, QAWF, more tests
......@@ -49,7 +49,8 @@
precision intervals, their integration results and error estimates.")
(defmfun integration-workspace-free (pointer)
"gsl_integration_workspace_free" ((pointer :pointer))
"gsl_integration_workspace_free"
((mpointer :pointer))
:c-return :void
:export nil
:index (letm integration-workspace)
......@@ -125,7 +126,7 @@
(function points limit workspace &optional (absolute-error 1.0d0) (relative-error 1.0d0))
"gsl_integration_qagp"
((function :pointer)
((pointer points) :pointer) ((dim0 points) sizet)
((mpointer points) :pointer) ((dim0 points) sizet)
(absolute-error :double) (relative-error :double) (limit sizet) (workspace :pointer)
(result :double) (abserr :double))
:documentation ; FDL
......
;; Series acceleration.
;; Liam Healy, Wed Nov 21 2007 - 18:41
;; Time-stamp: <2008-03-09 19:21:47EDT series-acceleration.lisp>
;; Time-stamp: <2008-08-23 11:30:37EDT series-acceleration.lisp>
;; $Id$
(in-package :gsl)
......@@ -11,9 +11,9 @@
(cffi:defcstruct levin
"The definition of Levin series acceleration for GSL."
(size size)
(position-in-array size)
(terms-used size)
(size sizet)
(position-in-array sizet)
(terms-used sizet)
(sum-plain :double)
(q-num :pointer)
(q-den :pointer)
......@@ -25,7 +25,7 @@
(defmfun allocate-levin (order)
"gsl_sum_levin_u_alloc"
((order size))
((order sizet))
:c-return :pointer
:export nil
:index (letm levin)
......@@ -44,7 +44,7 @@
(defmfun accelerate (array levin)
"gsl_sum_levin_u_accel"
(((gsl-array array) :pointer) ((dim0 array) size) (levin :pointer)
(((c-pointer array) :pointer) ((dim0 array) sizet) (levin :pointer)
(accelerated-sum :double) (absolute-error :double))
:documentation ; FDL
"From the terms of a series in array, compute the extrapolated
......@@ -65,7 +65,7 @@
(defmfun allocate-levin-truncated (order)
"gsl_sum_levin_utrunc_alloc"
((order size))
((order sizet))
:c-return :pointer
:export nil
:index (letm levin-truncated)
......@@ -84,7 +84,7 @@
(defmfun accelerate-truncated (array levin)
"gsl_sum_levin_utrunc_accel"
(((gsl-array array) :pointer) ((dim0 array) size) (levin :pointer)
(((c-pointer array) :pointer) ((dim0 array) sizet) (levin :pointer)
(accelerated-sum :double) (absolute-error :double))
:documentation ; FDL
"From the terms of a series in array, compute the extrapolated
......
;; Wavelet transforms.
;; Liam Healy, Mon Nov 26 2007 - 20:43
;; Time-stamp: <2008-03-09 19:29:17EDT wavelet.lisp>
;; Time-stamp: <2008-08-23 11:45:54EDT wavelet.lisp>
;; $Id$
(in-package :gsl)
......@@ -24,7 +24,7 @@
(defmfun allocate-wavelet (type member)
"gsl_wavelet_alloc"
((type :pointer) (member size))
((type :pointer) (member sizet))
:c-return :pointer
:export nil
:index (letm wavelet)
......@@ -88,7 +88,7 @@
(defmfun allocate-wavelet-workspace (size)
"gsl_wavelet_workspace_alloc"
((size size))
((size sizet))
:c-return :pointer
:export nil
:index (letm wavelet-workspace)
......@@ -115,8 +115,8 @@
(defmfun wavelet-transform (wavelet data stride direction workspace)
"gsl_wavelet_transform"
((wavelet :pointer) ((gsl-array data) :pointer)
(stride size) ((dim0 data) size) ((forward-backward direction) :int)
((wavelet :pointer) ((c-pointer data) :pointer)
(stride sizet) ((dim0 data) sizet) ((forward-backward direction) :int)
(workspace :pointer))
:documentation ; FDL
"Compute in-place forward and inverse discrete wavelet
......@@ -141,8 +141,8 @@
(defmfun wavelet-transform-forward (wavelet data stride workspace)
"gsl_wavelet_transform_forward"
((wavelet :pointer) ((gsl-array data) :pointer)
(stride size) ((dim0 data) size) (workspace :pointer))
((wavelet :pointer) ((c-pointer data) :pointer)
(stride sizet) ((dim0 data) sizet) (workspace :pointer))
:documentation ; FDL
"Compute in-place forward and inverse discrete wavelet
transforms on the array data. The length of the transform
......@@ -163,8 +163,8 @@
(defmfun wavelet-transform-inverse (wavelet data stride workspace)
"gsl_wavelet_transform_inverse"
((wavelet :pointer) ((gsl-array data) :pointer)
(stride size) ((dim0 data) size) (workspace :pointer))
((wavelet :pointer) ((c-pointer data) :pointer)
(stride sizet) ((dim0 data) sizet) (workspace :pointer))
:documentation ; FDL
"Compute in-place inverse discrete wavelet
transforms on the array data. The length of the transform
......@@ -189,8 +189,8 @@
(defmfun wavelet-2d-transform (wavelet data tda direction workspace)
"gsl_wavelet2d_transform"
((wavelet :pointer) ((gsl-array data) :pointer)
(tda size) ((dim0 data) size) ((dim1 data) size)
((wavelet :pointer) ((c-pointer data) :pointer)
(tda sizet) ((dim0 data) sizet) ((dim1 data) sizet)
((forward-backward direction) :int) (workspace :pointer))
:documentation ; FDL
"Compute in-place forward and inverse discrete wavelet transforms
......@@ -209,8 +209,8 @@
(defmfun wavelet-2d-transform-forward (wavelet data tda workspace)
"gsl_wavelet2d_transform_forward"
((wavelet :pointer) ((gsl-array data) :pointer)
(tda size) ((dim0 data) size) ((dim1 data) size)
((wavelet :pointer) ((c-pointer data) :pointer)
(tda sizet) ((dim0 data) sizet) ((dim1 data) sizet)
(workspace :pointer))
:documentation ; FDL
"Compute two-dimensional in-place forward and inverse
......@@ -227,8 +227,8 @@
(defmfun wavelet-2d-transform-inverse (wavelet data tda workspace)
"gsl_wavelet2d_transform_inverse"
((wavelet :pointer) ((gsl-array data) :pointer)
(tda size) ((dim0 data) size) ((dim1 data) size)
((wavelet :pointer) ((c-pointer data) :pointer)
(tda sizet) ((dim0 data) sizet) ((dim1 data) sizet)
(workspace :pointer))
:documentation ; FDL
"Compute two-dimensional in-place forward and inverse discrete
......@@ -243,50 +243,50 @@
(defmfun wavelet-2d-transform-matrix (wavelet data direction workspace)
"gsl_wavelet2d_transform_matrix"
((wavelet :pointer) ((gsl-array data) :pointer)
((wavelet :pointer) ((c-pointer data) :pointer)
((forward-backward direction) :int) (workspace :pointer))
:documentation ; FDL
"Compute the two-dimensional in-place wavelet transform on a matrix.")
(defmfun wavelet-2d-transform-matrix-forward (wavelet data workspace)
"gsl_wavelet2d_transform_matrix_forward"
((wavelet :pointer) ((gsl-array data) :pointer) (workspace :pointer))
((wavelet :pointer) ((c-pointer data) :pointer) (workspace :pointer))
:documentation ; FDL
"Compute the two-dimensional in-place wavelet transform on a matrix.")
(defmfun wavelet-2d-transform-matrix-inverse (wavelet data workspace)
"gsl_wavelet2d_transform_matrix_inverse"
((wavelet :pointer) ((gsl-array data) :pointer) (workspace :pointer))
((wavelet :pointer) ((c-pointer data) :pointer) (workspace :pointer))
:documentation ; FDL
"Compute the two-dimensional in-place wavelet transform on a matrix.")
(defmfun wavelet-2d-nonstandard-transform (wavelet data tda direction workspace)
"gsl_wavelet2d_nstransform"
((wavelet :pointer) ((gsl-array data) :pointer)
(tda size) ((dim0 data) size) ((dim1 data) size) (direction :int)
((wavelet :pointer) ((c-pointer data) :pointer)
(tda sizet) ((dim0 data) sizet) ((dim1 data) sizet) (direction :int)
(workspace :pointer))
:documentation ; FDL
"Compute the two-dimensional wavelet transform in non-standard form.")
(defmfun wavelet-2d-nonstandard-transform-forward (wavelet data tda workspace)
"gsl_wavelet2d_nstransform_forward"
((wavelet :pointer) ((gsl-array data) :pointer)
(tda size) ((dim0 data) size) ((dim1 data) size)
((wavelet :pointer) ((c-pointer data) :pointer)
(tda sizet) ((dim0 data) sizet) ((dim1 data) sizet)
(workspace :pointer))
:documentation ; FDL
"Compute the two-dimensional wavelet transform in non-standard form.")
(defmfun wavelet-2d-nonstandard-transform-inverse (wavelet data tda workspace)
"gsl_wavelet2d_nstransform_inverse"
((wavelet :pointer) ((gsl-array data) :pointer)
(tda size) ((dim0 data) size) ((dim1 data) size)
((wavelet :pointer) ((c-pointer data) :pointer)
(tda sizet) ((dim0 data) sizet) ((dim1 data) sizet)
(workspace :pointer))
:documentation ; FDL
"Compute the two-dimensional wavelet transform in non-standard form.")
(defmfun wavelet-2d-nonstandard-transform-matrix (wavelet data direction workspace)
"gsl_wavelet2d_nstransform_matrix"
((wavelet :pointer) ((gsl-array data) :pointer)
((wavelet :pointer) ((c-pointer data) :pointer)
(direction :int) (workspace :pointer))
:documentation
"Compute the non-standard form of the two-dimensional in-place wavelet
......@@ -294,14 +294,14 @@
(defmfun wavelet-2d-nonstandard-transform-matrix-forward (wavelet data workspace)
"gsl_wavelet2d_nstransform_matrix_forward"
((wavelet :pointer) ((gsl-array data) :pointer) (workspace :pointer))
((wavelet :pointer) ((c-pointer data) :pointer) (workspace :pointer))
:documentation ; FDL
"Compute the non-standard form of the two-dimensional in-place wavelet
transform on a matrix.")
(defmfun wavelet-2d-nonstandard-transform-matrix-inverse (wavelet data workspace)
"gsl_wavelet2d_nstransform_matrix_inverse"
((wavelet :pointer) ((gsl-array data) :pointer) (workspace :pointer))
((wavelet :pointer) ((c-pointer data) :pointer) (workspace :pointer))
:documentation ; FDL
"Compute the non-standard form of the two-dimensional in-place wavelet
transform on a matrix.")
......@@ -312,7 +312,7 @@
;;; See GSL manual Section 30.4.
(defparameter *wavelet-sample*
#(0.0462458471760794d0 0.0462458471760794d0 0.0512458471760794d0 0.0712458471760795d0
(a 0.0462458471760794d0 0.0462458471760794d0 0.0512458471760794d0 0.0712458471760795d0
0.0712458471760795d0 0.0662458471760795d0 0.0962458471760795d0 0.101245847176079d0
0.116245847176079d0 0.121245847176079d0 0.116245847176079d0 0.106245847176079d0
0.0912458471760794d0 0.101245847176079d0 0.0962458471760795d0 0.0962458471760795d0
......@@ -401,9 +401,8 @@
(setf (maref vector (maref permutation i))
0.0d0))) ;; Transform back
(dotimes (i n) (format t "~&~a" (maref vector i)))
(cl-invalidate vector)
(wavelet-transform-inverse wavelet vector 1 workspace)
(data vector)))
(cl-array vector)))
(defun wavelet-forward-example (&optional (cl-data *wavelet-sample*))
"Simpler example, with only a Daubechies wavelet forward transformation."
......@@ -412,5 +411,4 @@
(wavelet (wavelet *daubechies-wavelet* 4))
(workspace (wavelet-workspace n)))
(wavelet-transform-forward wavelet vector 1 workspace)
(cl-invalidate vector)
(data vector)))
(cl-array vector)))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment