Skip to content
Snippets Groups Projects
Commit 9b588763 authored by Liam Healy's avatar Liam Healy
Browse files

New class mobject, new hierarchy, clean up files

Redefine 'mobject from 'gsl-object.  The class 'gsl-data in data.lisp
is now a subclass of it, and does not explicitly have the mpointer
slot, because mobject does.  Adapted #'defmobject to work with objects
that have no "setter" (initialization).  This expands correctly for
basis-splines (no setter) and hankel (setter).  The basis-splines
defintions rely on the new mobjects.
parent 5cff6c7a
No related branches found
No related tags found
No related merge requests found
;; 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))
......
;; "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
......
;; 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)))
|#
......
;; 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)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment