diff --git a/basis-splines.lisp b/basis-splines.lisp index 17bcf76569c33e44ec08eeecde4790b29df3efda..a61907dce7cbd3686faaddd60eb328f29862e4f8 100644 --- a/basis-splines.lisp +++ b/basis-splines.lisp @@ -1,14 +1,25 @@ ;; Basis splines. ;; Liam Healy 2008-02-18 14:43:20EST basis-splines.lisp -;; Time-stamp: <2008-11-30 23:43:58EST basis-splines.lisp> +;; Time-stamp: <2008-12-21 21:46:10EST basis-splines.lisp> ;; $Id$ (in-package :gsl) -;;; Initializing the B-splines solver +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Should be subclass of interpolation? -(defgo-s (basis-spline order number-of-breakpoints) - allocate-basis-spline free-basis-spline nil 2) +#| +(defmobject basis-spline "gsl_bspline" + ((order sizet) (number-of-breakpoints sizet)) + "basis spline" ; FDL + "Allocate a workspace for computing B-splines. The number of + breakpoints is given by number-of-breakpoints. This leads to n = + nbreak + k - 2 basis functions where k = order. Cubic B-splines are + specified by k = 4. The size of the workspace is O(5k + nbreak).") +|# + +;;; Initializing the B-splines solver +(defgo-s (basis-spline order number-of-breakpoints) allocate-basis-spline free-basis-spline nil 2) (defmfun allocate-basis-spline (order number-of-breakpoints) "gsl_bspline_alloc" @@ -32,17 +43,17 @@ "Free the memory associated with the workspace of the bspline.") ;;; Constructing the knots vector - (defmfun knots (breakpoints workspace) "gsl_bspline_knots" - ((breakpoints :pointer) (workspace :pointer)) + (((mpointer breakpoints) :pointer) ((mpointer workspace) :pointer)) :documentation ; FDL "Compute the knots associated with the given breakpoints and store them in the workspace.") (defmfun uniform-knots (a b workspace) "gsl_bspline_knots_uniform" - ((a :double) (b :double) (workspace :pointer)) + ((a :double) (b :double) ((mpointer workspace) :pointer)) + :return (workspace) :documentation ; FDL "Compute knots uniformly on the interval [a, b] and store them in the workspace.") @@ -51,7 +62,7 @@ (defmfun evaluate-bspline (x B workspace) "gsl_bspline_eval" - ((x :double) ((mpointer B) :pointer) (workspace :pointer)) + ((x :double) ((mpointer B) :pointer) ((mpointer workspace) :pointer)) :outputs (B) :documentation ; FDL "Evaluate all B-spline basis functions at the position x and store @@ -62,6 +73,32 @@ compute them individually, due to the nature of the defining recurrence relation.") +;;; Query settings of the B-spline +;;; These are not documented but are in +;;; /usr/include/gsl/gsl_bspline.h; are they officially supported? + +(defmfun bspline-ncoeffs (B) + "gsl_bspline_ncoeffs" + (((mpointer B) :pointer)) + :c-return sizet) + +(defmfun bspline-order (B) + "gsl_bspline_order" + (((mpointer B) :pointer)) + :c-return sizet) + +(defmfun number-of-breakpoints (B) + "gsl_bspline_nbreak" + (((mpointer B) :pointer)) + :c-return sizet + :documentation "The number of breakpoints of the basis spline B.") + +(defmfun breakpoint (i B) + "gsl_bspline_breakpoint" + ((i sizet) ((mpointer B) :pointer)) + :c-return :double + :documentation "The ith breakpoint of the basis spline B.") + ;;; Examples and unit test #| @@ -72,7 +109,7 @@ (letm ((order 4) ; cubic (ndata 200) (nbreak (+ ncoeffs 2 (- order))) - (bw (basis-spline order nbreak)) + (bw (make-basis-spline order nbreak)) (mw (fit-workspace ndata ncoeffs)) (rng (random-number-generator *mt19937* 0)) (B (make-array* 'double-float :dimensions ncoeffs)) diff --git a/data/data.lisp b/data/data.lisp index 0ce4c14c0f795d51ae3ed4cbff8a907943775756..1a51583dec2bcc439d3ddbe28ff95ad0b459c134 100644 --- a/data/data.lisp +++ b/data/data.lisp @@ -1,7 +1,7 @@ ;; "Data" is bulk arrayed data, like vectors, matrices, permutations, ;; combinations, or histograms. ;; Liam Healy 2008-04-06 21:23:41EDT -;; Time-stamp: <2008-12-07 17:07:11EST data.lisp> +;; Time-stamp: <2008-12-21 17:58:34EST data.lisp> ;; $Id$ (in-package :gsl) @@ -10,10 +10,8 @@ ;;;; The class gsl-data and element types that make subclasses ;;;;**************************************************************************** -(defclass gsl-data () +(defclass gsl-data (mobject) ((cl-array :documentation "The Lisp array.") - (mpointer :accessor mpointer - :documentation "A pointer to the GSL representation of the data.") (block-pointer :initform nil :accessor block-pointer :documentation "A pointer to the gsl-block-c.") #-native diff --git a/hankel.lisp b/hankel.lisp index e88e2c60d911916eaa4f0e9fbcffc6b4c4a0744c..b9efaaaac80f10249d395952c43971c9328183c2 100644 --- a/hankel.lisp +++ b/hankel.lisp @@ -1,6 +1,6 @@ ;; Discrete Hankel Transforms. ;; Liam Healy, Sat Dec 8 2007 - 16:50 -;; Time-stamp: <2008-12-14 23:16:48EST hankel.lisp> +;; Time-stamp: <2008-12-21 21:38:24EST hankel.lisp> ;; $Id$ (in-package :gsl) @@ -10,6 +10,8 @@ (defmobject hankel "gsl_dht" ((size sizet)) "discrete Hankel Transform" + "Allocate a Discrete Hankel transform object of the given size and + optionally initialize the transform for the given values of nu and x." "new" ((nu :double) (xmax :double))) |# diff --git a/init/gsl-objects.lisp b/init/gsl-objects.lisp index 63deee90fff5b9d8ecca151c8100c788a7f44484..5da09102cb0d9024aa0f76e2d5d2af7625fd8e31 100644 --- a/init/gsl-objects.lisp +++ b/init/gsl-objects.lisp @@ -1,17 +1,17 @@ ;; Definition of GSL objects and ways to use them. ;; Liam Healy, Sun Dec 3 2006 - 10:21 -;; Time-stamp: <2008-12-15 18:21:19EST gsl-objects.lisp> +;; Time-stamp: <2008-12-21 21:35:42EST gsl-objects.lisp> ;; $Id$ (in-package :gsl) #| -(defclass gsl-object () +(defclass mobject () ((mpointer :accessor mpointer :documentation "A pointer to the GSL representation of the object."))) (defmacro defmobject - (class prefix allocation-args description + (class prefix allocation-args description docstring &optional initialize-suffix initialize-args) (let ((mptr (make-symbol "MPOINTER")) (maker (intern (format nil "MAKE-~:@(~a~)" class) :gsl)) @@ -21,7 +21,7 @@ (variables-used-in-c-arguments initialize-args)) (settingp (make-symbol "SETTINGP"))) `(progn - (defclass ,class (gsl-object) + (defclass ,class (mobject) () (:documentation ,(format nil "The GSL representation of the ~a." description))) @@ -41,29 +41,33 @@ :export nil :index ,maker) - (defmfun reinitialize-instance ((object ,class) &key ,@cl-initialize-args) - ,(format nil "~a_~a" prefix initialize-suffix) - (((mpointer object) :pointer) ,@initialize-args) - :definition :method - :qualifier :after - :return (object) - :export nil - :index (reinitialize-instance ,class)) + ,@(when initialize-suffix + `((defmfun reinitialize-instance ((object ,class) &key ,@cl-initialize-args) + ,(format nil "~a_~a" prefix initialize-suffix) + (((mpointer object) :pointer) ,@initialize-args) + :definition :method + :qualifier :after + :return (object) + :export nil + :index (reinitialize-instance ,class)))) (export ',maker) (defun ,maker (,@cl-alloc-args - &optional - ,@(cons (list (first cl-initialize-args) nil settingp) - (rest cl-initialize-args))) - ,(format nil "Create the GSL object representing a ~a (class ~a)." - description class) + ,@(when initialize-suffix + (append + (list '&optional + (list (first cl-initialize-args) nil settingp)) + (rest cl-initialize-args)))) + ,(format nil "Create the GSL object representing a ~a (class ~a).~&~a" + description class docstring) (let ((object (make-instance ',class ,@(symbol-keyword-symbol cl-alloc-args)))) - (when ,settingp - (reinitialize-instance - object - ,@(symbol-keyword-symbol cl-initialize-args))) + ,@(when initialize-suffix + `((when ,settingp + (reinitialize-instance + object + ,@(symbol-keyword-symbol cl-initialize-args))))) object))))) (defun symbol-keyword-symbol (symbol)