From b40b323860003933682d80647506119535d60964 Mon Sep 17 00:00:00 2001 From: liam <liam@a3d8a0fb-c1db-0310-ace7-a616afeb9e30> Date: Wed, 6 Feb 2008 03:45:55 +0000 Subject: [PATCH] Eliminate the last of with-data; minor bug fixes. git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3284 a3d8a0fb-c1db-0310-ace7-a616afeb9e30 --- data/combination.lisp | 96 ++++---- data/data.lisp | 40 +--- data/matrix.lisp | 180 +++++++-------- data/vector.lisp | 354 ++++++++++++++---------------- gsll.asd | 4 +- histogram/updating-accessing.lisp | 2 +- polynomial.lisp | 4 +- wavelet.lisp | 4 +- 8 files changed, 304 insertions(+), 380 deletions(-) diff --git a/data/combination.lisp b/data/combination.lisp index ed829973..8826f2f2 100644 --- a/data/combination.lisp +++ b/data/combination.lisp @@ -1,11 +1,7 @@ -;******************************************************** -; file: combination.lisp -; description: Combinations -; date: Sun Mar 26 2006 - 11:51 -; author: Liam M. Healy -; modified: Mon Jun 5 2006 - 11:19 -;******************************************************** -;;; $Id: $ +;; Combinations +;; Liam Healy, Sun Mar 26 2006 - 11:51 +;; Time-stamp: <2008-02-04 19:25:57EST combination.lisp> +;; $Id: $ (in-package :gsl) @@ -34,7 +30,8 @@ (((pointer combination) :pointer) ((first indices) :size)) :type :method :c-return :size - :documentation "The ith element of the combination.") + :documentation ; FDL + "The ith element of the combination.") (defmethod data ((object gsl-combination) &optional sequence) (let ((seq (or sequence @@ -53,18 +50,18 @@ (((pointer combination) gsl-combination-c)) :c-return :void :invalidate (combination) - :documentation - "Initialize the combination @var{c} to the lexicographically - first combination, i.e. @math{(0,1,2,@dots{},k-1)}.") + :documentation ; FDL + "Initialize the combination c to the lexicographically + first combination, i.e. (0,1,2,...,k-1).") (defun-gsl init-last (combination) "gsl_combination_init_last" (((pointer combination) gsl-combination-c)) :c-return :void :invalidate (combination) - :documentation - "Initialize the combination @var{c} to the lexicographically - last combination, i.e. @math{(n-k,n-k+1,@dots{},n-1)}.") + :documentation ; FDL + "Initialize the combination c to the lexicographically + last combination, i.e. (n-k,n-k+1,...,n-1).") (defun-gsl copy (destination source) "gsl_combination_memcpy" @@ -72,9 +69,9 @@ ((pointer source) gsl-combination-c)) :type :method :invalidate (destination) - :documentation - "Copy the elements of the combination @var{src} into the - combination @var{dest}. The two combinations must have the same size.") + :documentation ; FDL + "Copy the elements of the combination source into the + combination destination. The two combinations must have the same size.") ;;;;**************************************************************************** ;;;; Combination properties @@ -84,15 +81,15 @@ "gsl_combination_n" (((pointer c) gsl-combination-c)) :c-return :size - :documentation - "The range (@math{n}) of the combination @var{c}.") + :documentation ; FDL + "The range (n) of the combination c.") (defun-gsl combination-size (c) "gsl_combination_k" (((pointer c) gsl-combination-c)) :c-return :size - :documentation - "The number of elements (@math{k}) in the combination @var{c}.") + :documentation ; FDL + "The number of elements (k) in the combination c.") #| ;;; Unnecessary, gsl-array serves this function. @@ -100,8 +97,8 @@ "gsl_combination_data" (((pointer c) gsl-combination-c)) :c-return :pointer - :documentation - "A pointer to the array of elements in the combination @var{p}.") + :documentation ; FDL + "A pointer to the array of elements in the combination.") |# (defun-gsl data-valid ((combination gsl-combination)) @@ -109,9 +106,9 @@ (((pointer combination) :pointer)) :type :method :c-return :boolean - :documentation - "Check that the combination @var{c} is valid. The @var{k} - elements should lie in the range 0 to @math{@var{n}-1}, with each + :documentation ; FDL + "Check that the combination is valid. The k + elements should lie in the range 0 to n-1, with each value occurring once at most and in increasing order.") ;;;;**************************************************************************** @@ -122,11 +119,11 @@ "gsl_combination_next" (((pointer c) gsl-combination-c)) :c-return :success-failure :invalidate (c) - :documentation - "Advance the combination @var{c} to the next combination + :documentation ; FDL + "Advance the combination c to the next combination in lexicographic order and return T and c. If no further combinations are available it return NIL and c with - @var{c} unmodified. Starting with the first combination and + c unmodified. Starting with the first combination and repeatedly applying this function will iterate through all possible combinations of a given order.") @@ -135,42 +132,43 @@ (((pointer c) gsl-combination-c)) :c-return :success-failure :invalidate (c) - :documentation - "Step backwards from the combination @var{c} to the + :documentation ; FDL + "Step backwards from the combination c to the previous combination in lexicographic order, returning T and c. If no previous combination is available it returns - NIL and c with @var{c} unmodified.") + NIL and c with c unmodified.") ;;;;**************************************************************************** ;;;; Examples and unit test ;;;;**************************************************************************** -(defparameter *comb-1* (make-data 'combination t 4 2)) - (lisp-unit:define-test combination (lisp-unit:assert-eql ; combination-range 4 - (combination-range *comb-1*)) + (letm ((comb (combination 4 2 t))) + (combination-range comb))) (lisp-unit:assert-eql ; combination-size 2 - (combination-size *comb-1*)) + (letm ((comb (combination 4 2 t))) + (combination-size comb))) (lisp-unit:assert-equal ; init-first, combination-next '((0 1) (0 2) (0 3) (1 2) (1 3) (2 3)) - (progn - (init-first *comb-1*) - (loop collect (data *comb-1*) - while (combination-next *comb-1*)))) - (lisp-unit:assert-equal ; init-last, combination-previous + (letm ((comb (combination 4 2 t))) + (init-first comb) + (loop collect (data comb) + while (combination-next comb)))) + (lisp-unit:assert-equal ; init-last, combination-previous '((2 3) (1 3) (1 2) (0 3) (0 2) (0 1)) - (progn - (init-last *comb-1*) - (loop collect (data *comb-1*) - while (combination-previous *comb-1*)))) - (lisp-unit:assert-equal ; with-data, combination-next + (letm ((comb (combination 4 2 t))) + (init-last comb) + (loop collect (data comb) + while (combination-previous comb)))) + (lisp-unit:assert-equal ; combination-next '(NIL (0) (1) (2) (3) (0 1) (0 2) (0 3) (1 2) (1 3) (2 3) (0 1 2) (0 1 3) (0 2 3) (1 2 3) (0 1 2 3)) (loop for i from 0 to 4 append - (with-data (comb combination (4 i) t) + (letm ((comb (combination 4 i t))) + (init-first comb) (loop collect (data comb) - while (combination-next comb)))))) + while (combination-next comb)))))) diff --git a/data/data.lisp b/data/data.lisp index bac81144..67703567 100644 --- a/data/data.lisp +++ b/data/data.lisp @@ -1,6 +1,6 @@ ;; Using GSL storage. ;; Liam Healy, Sun Mar 26 2006 - 16:32 -;; Time-stamp: <2008-02-03 23:34:26EST data.lisp> +;; Time-stamp: <2008-02-05 22:32:15EST data.lisp> ;; $Id: $ (in-package :gsl) @@ -155,10 +155,11 @@ collect `((nth ,i (storage-size object)) :size))) (object-name (make-symbol-from-strings *gsl-prefix* cl-symbol))) `(progn - (data-go ,cl-symbol ,(eq superclass 'gsl-matrix)) (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)))) (defun-gsl alloc ((object ,object-name)) ,(gsl-name "alloc") ,cargs :type :method @@ -234,7 +235,7 @@ ;;;; Making data objects and initializing storage ;;;;**************************************************************************** -(export '(make-data with-data)) +(export '(make-data)) (defgeneric alloc (object) (:documentation "Allocate GSL data; used internally.")) @@ -258,39 +259,6 @@ (if zero (calloc obj) (alloc obj)) obj)) -(defmacro with-data ((symbol type size &optional zero) &body body) - "Allocate GSL data, bind to pointer, - and then deallocated it when done. If zero is T, zero the - contents when allocating." - `(let ((,symbol - (make-data ',type ,zero ,@(if (listp size) size (list size))))) - (unwind-protect - (progn ,@body) - (free ,symbol)))) - -#| -(defun make-data (type zero size) - "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 (if (listp size) size (list size))))) - (if zero (calloc obj) (alloc obj)) - obj)) - -(defmacro with-data ((symbol type size &optional zero) &body body) - "Allocate GSL data, bind to pointer, - and then deallocated it when done. If zero is T, zero the - contents when allocating." - `(let ((,symbol - (make-data ',type ,zero ,size))) - (unwind-protect - (progn ,@body) - (free ,symbol)))) -|# - ;;;;**************************************************************************** ;;;; Getting values into CL ;;;;**************************************************************************** diff --git a/data/matrix.lisp b/data/matrix.lisp index ff6a7710..e36e6b9b 100644 --- a/data/matrix.lisp +++ b/data/matrix.lisp @@ -1,6 +1,6 @@ ;; Matrices ;; Liam Healy, Sun Mar 26 2006 - 11:51 -;; Time-stamp: <2008-02-02 23:44:57EST matrix.lisp> +;; Time-stamp: <2008-02-05 22:38:36EST matrix.lisp> ;; $Id: $ (in-package :gsl) @@ -73,7 +73,8 @@ ((first indices) :size) ((second indices) :size)) :c-return :c-base-type - :documentation "The (i,j)-th element of the matrix.") ;FDL + :documentation ; FDL + "The (i,j)-th element of the matrix.") (defun-gsl mref (pointer index0 index1) "gsl_matrix_get" @@ -153,9 +154,9 @@ "gsl_matrix_set_identity" (((pointer matrix) gsl-matrix-c)) :c-return :void :documentation ; FDL - "Set the elements of the matrix @var{m} to the - corresponding elements of the identity matrix, @math{m(i,j) = - \delta(i,j)}, i.e. a unit diagonal with all off-diagonal elements zero. + "Set the elements of the matrix m to the + corresponding elements of the identity matrix, m(i,j) = + \delta(i,j), i.e. a unit diagonal with all off-diagonal elements zero. This applies to both square and rectangular matrices.") ;;;;**************************************************************************** @@ -574,124 +575,99 @@ ;;;; Examples and unit test ;;;;**************************************************************************** -(defparameter *intmat-1* (make-data 'matrix-fixnum nil 2 2)) -(defparameter *intmat-2* (make-data 'matrix-fixnum nil 2 2)) -(defparameter *intmatvec* (make-data 'vector-fixnum nil 2)) - (lisp-unit:define-test matrix-fixnum (lisp-unit:assert-eql ;(setf gsl-aref), gsl-aref 77 - (progn - (setf (gsl-aref *intmat-1* 0 1) 77) - (gsl-aref *intmat-1* 0 1))) + (letm ((intmat (matrix-fixnum 2 2))) + (setf (gsl-aref intmat 0 1) 77) + (gsl-aref intmat 0 1))) (lisp-unit:assert-equalp ;(setf data) #2A((4 6) (8 2)) - (progn (setf (data *intmat-1*) #2A((4 6) (8 2))) (data *intmat-1*))) + (letm ((intmat (matrix-fixnum 2 2))) + (setf (data intmat) #2A((4 6) (8 2))) + (data intmat))) (lisp-unit:assert-equalp ;set-zero #2A((0 0) (0 0)) - (progn (set-zero *intmat-1*) (data *intmat-1*))) + (letm ((intmat (matrix-fixnum 2 2))) + (set-zero intmat) + (data intmat))) (lisp-unit:assert-equalp ;set-all #2A((44 44)(44 44)) - (progn (set-all *intmat-1* 44) (data *intmat-1*))) - (lisp-unit:assert-equalp ;set-basis + (letm ((intmat (matrix-fixnum 2 2))) + (set-all intmat 44) + (data intmat))) + (lisp-unit:assert-equalp ;set-identity #2A((1 0)(0 1)) - (progn (set-identity *intmat-1*) (data *intmat-1*))) + (letm ((intmat (matrix-fixnum 2 2))) + (set-identity intmat) + (data intmat))) (lisp-unit:assert-equalp ;row #(4 6) - (progn - (setf (data *intmat-1*) #2A((4 6) (8 2))) - (row *intmatvec* *intmat-1* 0) - (data *intmatvec*))) + (letm ((intmat (matrix-fixnum #2A((4 6) (8 2)))) + (vect (vector-fixnum 2))) + (row vect intmat 0) + (data vect))) (lisp-unit:assert-equalp ;column #(6 2) - (progn - (setf (data *intmat-1*) #2A((4 6) (8 2))) - (column *intmatvec* *intmat-1* 1) - (data *intmatvec*))) + (letm ((intmat (matrix-fixnum #2A((4 6) (8 2)))) + (vect (vector-fixnum 2))) + (column vect intmat 1) + (data vect))) (lisp-unit:assert-eql ;gsl-min -12 - (progn - (setf (data *intmat-1*) #2A((-1 -12) (8 3))) - (gsl-min *intmat-1*))) + (letm ((intmat (matrix-fixnum #2A((-1 -12) (8 3))))) + (gsl-min intmat))) (lisp-unit:assert-eql ;gsl-max 8 - (progn - (setf (data *intmat-1*) #2A((-1 -12) (8 3))) - (gsl-max *intmat-1*))) + (letm ((intmat (matrix-fixnum #2A((-1 -12) (8 3))))) + (gsl-max intmat))) (lisp-unit:assert-equal ;gsl-minmax '(-12 8) - (progn - (setf (data *intmat-1*) #2A((-1 -12) (8 3))) - (multiple-value-list (gsl-minmax *intmat-1*)))) + (letm ((intmat (matrix-fixnum #2A((-1 -12) (8 3))))) + (multiple-value-list (gsl-minmax intmat)))) (lisp-unit:assert-equal ;gsl-min-index '(0 1) - (progn - (setf (data *intmat-1*) #2A((-1 -12) (8 3))) - (gsl-min-index *intmat-1*))) + (letm ((intmat (matrix-fixnum #2A((-1 -12) (8 3))))) + (gsl-min-index intmat))) (lisp-unit:assert-equal ;gsl-max-index '(1 0) - (progn - (setf (data *intmat-1*) #2A((-1 -12) (8 3))) - (gsl-max-index *intmat-1*))) + (letm ((intmat (matrix-fixnum #2A((-1 -12) (8 3))))) + (gsl-max-index intmat))) (lisp-unit:assert-equal ;gsl-minmax-index '((0 1) (1 0)) - (progn - (setf (data *intmat-1*) #2A((-1 -12) (8 3))) - (multiple-value-list (gsl-minmax-index *intmat-1*)))) + (letm ((intmat (matrix-fixnum #2A((-1 -12) (8 3))))) + (multiple-value-list (gsl-minmax-index intmat)))) (lisp-unit:assert-equalp ;copy #2A((1 2)(3 4)) - (progn - (setf (data *intmat-1*) #2A((1 2)(3 4))) - (copy *intmat-2* *intmat-1*) (data *intmat-2*))) + (letm ((intmat1 (matrix-fixnum #2A((1 2)(3 4)))) + (intmat2 (matrix-fixnum 2 2))) + (copy intmat2 intmat1) + (data intmat2))) (lisp-unit:assert-equalp ;swap #2A((5 6) (7 8)) - (progn - (setf (data *intmat-1*) #2A((1 2) (3 4)) - (data *intmat-2*) #2A((5 6) (7 8))) - (swap *intmat-1* *intmat-2*) - (data *intmat-1*))) + (letm ((intmat1 (matrix-fixnum #2A((1 2)(3 4)))) + (intmat2 (matrix-fixnum #2A((5 6) (7 8))))) + (swap intmat1 intmat2) + (data intmat1))) (lisp-unit:assert-equalp ;swap-rows #2A((3 4) (1 2)) - (progn - (setf (data *intmat-1*) #2A((1 2) (3 4))) - (swap-rows *intmat-1* 0 1) - (data *intmat-1*))) + (letm ((intmat1 (matrix-fixnum #2A((1 2)(3 4))))) + (swap-rows intmat1 0 1) + (data intmat1))) (lisp-unit:assert-equalp ;swap-columns #2A((2 1) (4 3)) - (progn - (setf (data *intmat-1*) #2A((1 2) (3 4))) - (swap-columns *intmat-1* 0 1) - (data *intmat-1*))) + (letm ((intmat1 (matrix-fixnum #2A((1 2)(3 4))))) + (swap-columns intmat1 0 1) + (data intmat1))) (lisp-unit:assert-equalp ;swap-rowcol #2A((2 4) (3 1)) - (progn - (setf (data *intmat-1*) #2A((1 2) (3 4))) - (swap-rowcol *intmat-1* 0 1) - (data *intmat-1*)))) - -;;;;**************************************************************************** -;;;; Examples -;;;;**************************************************************************** - -#| - -(with-data (mat matrix (10 3)) - (loop for i from 0 below 10 - do - (loop for j from 0 below 3 - do (setf (gsl-aref mat i j) (+ 0.23d0 j (* 100 i))))) - (loop for i from 0 below 10 - do - (loop for j from 0 below 3 do (print (gsl-aref mat i j))))) - -(with-data (mat matrix (10 3)) - (loop for i from 0 below 10 - do - (loop for j from 0 below 3 - do (setf (gsl-aref mat i j) (+ 0.23d0 j (* 100 i))))) - (data mat)) + (letm ((intmat1 (matrix-fixnum #2A((1 2)(3 4))))) + (swap-rowcol intmat1 0 1) + (data intmat1)))) -#2A((0.23d0 1.23d0 2.23d0) +(lisp-unit:define-test matrix-double + (lisp-unit:assert-equalp + #2A((0.23d0 1.23d0 2.23d0) (100.23d0 101.23d0 102.23d0) (200.23d0 201.23d0 202.23d0) (300.23d0 301.23d0 302.23d0) @@ -701,18 +677,20 @@ (700.23d0 701.23d0 702.23d0) (800.23d0 801.23d0 802.23d0) (900.23d0 901.23d0 902.23d0)) - -(with-data (mat matrix (2 2)) - (setf (data mat) #2A((1.0d0 2.0d0) (3.0d0 4.0d0))) - (with-data (ans matrix (2 2)) - (matrix-copy ans mat) - (data ans))) -;;; #2A((1.0d0 2.0d0) (3.0d0 4.0d0)) - -(with-data (mat matrix (2 2)) - (setf (data mat) #2A((1.0d0 2.0d0) (3.0d0 4.0d0))) - (matrix* mat mat) - (data mat))) -;;; #2A((1.0d0 4.0d0) (9.0d0 16.0d0)) - -|# + (letm ((mat (matrix-double 10 3))) + (loop for i from 0 below 10 + do + (loop for j from 0 below 3 + do (setf (gsl-aref mat i j) (+ 0.23d0 j (* 100 i))))) + (data mat))) + (lisp-unit:assert-equalp + #2A((1.0d0 2.0d0) (3.0d0 4.0d0)) + (letm ((mat (matrix-double #2A((1.0d0 2.0d0) (3.0d0 4.0d0)))) + (ans (matrix-double 2 2))) + (copy ans mat) + (data ans)) + (lisp-unit:assert-equalp + #2A((1.0d0 4.0d0) (9.0d0 16.0d0)) + (letm ((mat (matrix-double #2A((1.0d0 2.0d0) (3.0d0 4.0d0))))) + (gsl* mat mat) + (data mat))))) diff --git a/data/vector.lisp b/data/vector.lisp index 53fc30eb..6fef7d16 100644 --- a/data/vector.lisp +++ b/data/vector.lisp @@ -1,6 +1,6 @@ ;; Vectors ;; Liam Healy, Sun Mar 26 2006 - 11:51 -;; Time-stamp: <2008-02-02 23:45:19EST vector.lisp> +;; Time-stamp: <2008-02-04 19:44:24EST vector.lisp> ;; $Id: $ (in-package :gsl) @@ -33,16 +33,17 @@ ;;;;**************************************************************************** #| -The @var{size} is simply the number of vector elements. The range of -valid indices runs from 0 to @code{size-1}. The @var{stride} is the +;;FDL +The size is simply the number of vector elements. The range of +valid indices runs from 0 to size-1. The stride is the step-size from one element to the next in physical memory, measured in -units of the appropriate datatype. The pointer @var{data} gives the +units of the appropriate datatype. The pointer data gives the location of the first element of the vector in memory. The pointer -@var{block} stores the location of the memory block in which the vector +block stores the location of the memory block in which the vector elements are located (if any). If the vector owns this block then the -@var{owner} field is set to one and the block will be deallocated when the +owner field is set to one and the block will be deallocated when the vector is freed. If the vector points to a block owned by another -object then the @var{owner} field is zero and any underlying block will not be +object then the owner field is zero and any underlying block will not be deallocated with the vector. |# @@ -107,7 +108,8 @@ deallocated with the vector. "gsl_vector_get" (((pointer vector) :pointer) ((first indices) :size)) :c-return :c-base-type - :documentation "The ith element of the vector.") + :documentation ; FDL + "The ith element of the vector.") (defun-gsl vref (pointer index) "gsl_vector_get" @@ -119,7 +121,8 @@ deallocated with the vector. (defun-gsl gsl-vector-ptr (vector i) "gsl_vector_ptr" (((pointer vector) :pointer) (i :size)) :c-return :pointer - :documentation "The ith element of the vector as a pointer.") + :documentation ; FDL + "The ith element of the vector as a pointer.") ;;;;**************************************************************************** ;;;; Setting values @@ -129,14 +132,16 @@ deallocated with the vector. "gsl_vector_set" (((pointer vector) :pointer) ((first indices) :size) (value :c-base-type)) :c-return :void - :documentation "Set an element of the vector.") + :documentation ; FDL + "Set an element of the vector.") (defun-gsl (setf vref) (value pointer index) "gsl_vector_set" ((pointer :pointer) (index :size) (value :double)) :c-return :void :index nil - :documentation "Set an element of the vector of doubles, using its pointer.") + :documentation ; FDL + "Set an element of the vector of doubles, using its pointer.") (defun-gsl-vdsfc set-all ((object gsl-vector) value) "gsl_vector_set_all" @@ -149,8 +154,9 @@ deallocated with the vector. (defun-gsl-vdsfc set-basis ((vector gsl-vector) index) "gsl_vector_set_basis" (((pointer vector) gsl-vector-c) (index :size)) - :documentation "Set the index element to 1, and the rest to 0." - :invalidate (vector)) + :invalidate (vector) + :documentation ; FDL + "Set the index element to 1, and the rest to 0.") ;;;;**************************************************************************** ;;;; Views @@ -159,24 +165,28 @@ deallocated with the vector. (cffi:defcstruct gsl-vector-view (vector gsl-vector-c)) +;;; broken +;;; (letm ((vec (vector-double #(-3.21d0 1.0d0 12.8d0)))) (subvector vec 1 2)) + (export '(subvector subvector-stride)) (defgeneric subvector (vector offset size) - (:documentation + (:documentation ; FDL "Return a vector view of a subvector of another vector - @var{v}. The start of the new vector is offset by @var{offset} elements - from the start of the original vector. The new vector has @var{size} + v. The start of the new vector is offset by offset elements + from the start of the original vector. The new vector has size elements.")) (defgeneric subvector-stride (vector offset stride size) - (:documentation "A vector view of a subvector of another vector - @var{v} with an additional stride argument. The subvector is formed in - the same way as for @code{gsl_vector_subvector} but the new vector has - @var{n} elements with a step-size of @var{stride} from one element to - the next in the original vector. Mathematically, the @var{i}-th element - of the new vector @var{v'} is given by + (:documentation ; FDL + "A vector view of a subvector of another vector + v with an additional stride argument. The subvector is formed in + the same way as for #'subvector but the new vector has + n elements with a step-size of stride from one element to + the next in the original vector. Mathematically, the i-th element + of the new vector v' is given by v'(i) = v->data[(offset + i*stride)*v->stride] - where the index @var{i} runs from 0 to @code{n-1}. + where the index i runs from 0 to n-1. Note that subvector views give direct access to the underlying elements of the original vector.")) @@ -197,29 +207,29 @@ deallocated with the vector. "gsl_vector_complex_real" ((vector gsl-vector-complex)) :c-return :pointer :documentation - "A vector view of the real parts of the complex vector @var{v}.") + "A vector view of the real parts of the complex vector v.") (defun-gsl vector-complex-imag (vector) "gsl_vector_complex_imag"((vector gsl-vector-complex)) :c-return :pointer :documentation - "A vector view of the imaginary parts of the complex vector @var{v}.") + "A vector view of the imaginary parts of the complex vector v.") |# (defun-gsl vector-array (base size) "gsl_vector_view_array" ((base :pointer) (size :size)) :c-return :pointer - :documentation + :documentation ; FDL "A vector view of an array. The start of the new - vector is given by @var{base} and has @var{n} elements.") + vector is given by base and has n elements.") (defun-gsl vector-array-stride (base stride size) "gsl_vector_view_array_with_stride" ((base :pointer) (stride :size) (size :size)) :c-return :pointer - :documentation + :documentation ; FDL "A vector view of an array with stride. The start of the new - vector is given by @var{base}.") + vector is given by base.") ;;;;**************************************************************************** ;;;; Copying @@ -229,15 +239,15 @@ deallocated with the vector. "gsl_vector_memcpy" (((pointer destination) gsl-vector-c) ((pointer source) gsl-vector-c)) :invalidate (destination) - :documentation - "Copy the elements of the vector @var{source} into the - vector @var{destination}. The two vectors must have the same length.") + :documentation ; FDL + "Copy the elements of the vector source into the + vector destination. The two vectors must have the same length.") (defun-gsl-vdsfc swap ((v gsl-vector) (w gsl-vector)) "gsl_vector_swap" (((pointer v) gsl-vector-c) ((pointer w) gsl-vector-c)) :invalidate (v w) - :documentation - "Exchange the elements of the vectors @var{v} and @var{w} + :documentation ; FDL + "Exchange the elements of the vectors v and w by copying. The two vectors must have the same length.") ;;;;**************************************************************************** @@ -247,14 +257,12 @@ deallocated with the vector. (export '(swap-elements vector-reverse)) (defgeneric swap-elements (vec i j) - (:documentation - "Exchange the @var{i}-th and @var{j}-th elements of the - vector @var{vec} in-place.")) + (:documentation ; FDL + "Exchange the i-th and j-th elements of the vector vec in-place.")) (defgeneric vector-reverse (vec) (:documentation - "Exchange the @var{i}-th and @var{j}-th elements of the - vector @var{vec} in-place.")) + "Exchange the i-th and j-th elements of the vector vec in-place.")) (defun-gsl-vdsfc swap-elements ((vec gsl-vector) i j) "gsl_vector_swap_elements" (((pointer vec) gsl-vector-c) (i :size) (j :size)) @@ -266,8 +274,8 @@ deallocated with the vector. (defun-gsl-vdsfc vector-reverse ((vec gsl-vector)) "gsl_vector_reverse" (((pointer vec) gsl-vector-c)) :invalidate (vec) - :documentation - "Reverse the order of the elements of the vector @var{vec}.") + :documentation ; FDL + "Reverse the order of the elements of the vector vec.") ;;;;**************************************************************************** ;;;; Arithmetic operations @@ -276,48 +284,43 @@ deallocated with the vector. (defun-gsl-vdsf gsl+ ((a gsl-vector) (b gsl-vector)) "gsl_vector_add" (((pointer a) gsl-vector-c) ((pointer b) gsl-vector-c)) :invalidate (a) - :documentation - "Add the elements of vector @var{b} to the elements of - vector @var{a}, @math{a'_i = a_i + b_i}. The two vectors must have the + :documentation ; FDL + "Add the elements of vector b to the elements of + vector a, a'_i = a_i + b_i. The two vectors must have the same length.") (defun-gsl-vdsf gsl- ((a gsl-vector) (b gsl-vector)) "gsl_vector_sub" (((pointer a) gsl-vector-c) ((pointer b) gsl-vector-c)) :invalidate (a) - :documentation - "Subtract the elements of vector @var{b} from the elements of -vector @var{a}, @math{a'_i = a_i - b_i}. The two vectors must have the -same length.") + :documentation ; FDL + "Subtract the elements of vector b from the elements of + vector a, a'_i = a_i - b_i. The two vectors must have the same length.") (defun-gsl-vdsf gsl* ((a gsl-vector) (b gsl-vector)) "gsl_vector_mul" (((pointer a) gsl-vector-c) ((pointer b) gsl-vector-c)) :invalidate (a) - :documentation - "Multiply the elements of vector @var{a} by the elements of - vector @var{b}, @math{a'_i = a_i * b_i}. The two vectors must have the - same length.") + :documentation ; FDL + "Multiply the elements of vector a by the elements of + vector b, a'_i = a_i * b_i. The two vectors must have the same length.") (defun-gsl-vdsf gsl/ ((a gsl-vector) (b gsl-vector)) "gsl_vector_div" (((pointer a) gsl-vector-c) ((pointer b) gsl-vector-c)) :invalidate (a) - :documentation - "Divide the elements of vector @var{a} by the elements of - vector @var{b}, @math{a'_i = a_i / b_i}. The two vectors must have the - same length.") + :documentation ; FDL + "Divide the elements of vector a by the elements of + vector b, a'_i = a_i / b_i. The two vectors must have the same length.") (defun-gsl-vdsf gsl*c ((a gsl-vector) x) "gsl_vector_scale" (((pointer a) gsl-vector-c) (x :double)) :invalidate (a) - :documentation - "Multiply the elements of vector @var{a} by the constant - factor @var{x}, @math{a'_i = x a_i}.") + :documentation ; FDL + "Multiply the elements of vector a by the constant factor x, a'_i = x a_i.") (defun-gsl-vdsf gsl+c ((a gsl-vector) x) "gsl_vector_add_constant" (((pointer a) gsl-vector-c) (x :double)) :invalidate (a) - :documentation - "Add the constant value @var{x} to the elements of the - vector @var{a}, @math{a'_i = a_i + x}.") + :documentation ; FDL + "Add the constant value x to the elements of the vector a, a'_i = a_i + x.") ;;;;**************************************************************************** ;;;; Maximum and minimum elements @@ -325,46 +328,46 @@ same length.") (defun-gsl-vdsf gsl-max ((v gsl-vector)) "gsl_vector_max" (((pointer v) gsl-vector-c)) - :documentation - "The maximum value in the vector @var{v}." - :c-return :c-base-type) + :c-return :c-base-type + :documentation ; FDL + "The maximum value in the vector v.") (defun-gsl-vdsf gsl-min ((v gsl-vector)) "gsl_vector_min" (((pointer v) gsl-vector-c)) - :documentation - "The minimum value in the vector @var{v}." - :c-return :c-base-type) + :c-return :c-base-type + :documentation ; FDL + "The minimum value in the vector v.") (defun-gsl-vdsf gsl-minmax ((v gsl-vector)) "gsl_vector_minmax" (((pointer v) gsl-vector-c) (min :c-base-type) (max :c-base-type)) - :documentation - "The minimum and maximum values in the vector @var{v}." - :c-return :void) + :c-return :void + :documentation ; FDL + "The minimum and maximum values in the vector v.") (defun-gsl-vdsf gsl-max-index ((v gsl-vector)) "gsl_vector_max_index" (((pointer v) gsl-vector-c)) - :documentation - "The index of the maximum value in the vector @var{v}. + :c-return :size + :documentation ; FDL + "The index of the maximum value in the vector v. When there are several equal minimum elements then the lowest index is - returned." - :c-return :size) + returned.") (defun-gsl-vdsf gsl-min-index ((v gsl-vector)) "gsl_vector_min_index" (((pointer v) gsl-vector-c)) - :documentation - "The index of the minimum value in the vector @var{v}. When there are several - equal minimum elements then the lowest index is returned." - :c-return :size) + :c-return :size + :documentation ; FDL + "The index of the minimum value in the vector v. When there are several + equal minimum elements then the lowest index is returned.") (defun-gsl-vdsf gsl-minmax-index ((v gsl-vector)) "gsl_vector_minmax_index" (((pointer v) gsl-vector-c) (imin :size) (imax :size)) - :documentation - "The indices of the minimum and maximum values in the vector @var{v}. + :c-return :void + :documentation ; FDL + "The indices of the minimum and maximum values in the vector v. When there are several equal minimum elements then the lowest index is - returned." - :c-return :void) + returned.") ;;;;**************************************************************************** ;;;; Properties @@ -372,142 +375,119 @@ same length.") (defun-gsl-vdsfc gsl-zerop ((v gsl-vector)) "gsl_vector_isnull" (((pointer v) gsl-vector-c)) - :documentation - "All elements of vector @var{v} are zero." - :c-return :boolean) + :c-return :boolean + :documentation ; FDL + "All elements of vector v are zero.") ;;;;**************************************************************************** -;;;; Examples and unit test +;;;; Examples and unit tests ;;;;**************************************************************************** -(defparameter *intvec-1* (make-data 'vector-fixnum nil 4)) -(defparameter *intvec-2* (make-data 'vector-fixnum nil 4)) - (lisp-unit:define-test vector-fixnum (lisp-unit:assert-eql ;(setf gsl-aref), gsl-aref 77 - (progn - (setf (gsl-aref *intvec-1* 1) 77) - (gsl-aref *intvec-1* 1))) + (letm ((intvec (vector-fixnum 4))) + (setf (gsl-aref intvec 1) 77) + (gsl-aref intvec 1))) (lisp-unit:assert-equalp ;(setf data) #(4 6 8 2) - (progn (setf (data *intvec-1*) #(4 6 8 2)) (data *intvec-1*))) + (letm ((intvec (vector-fixnum 4))) + (setf (data intvec) #(4 6 8 2)) + (data intvec))) (lisp-unit:assert-equalp ;set-zero #(0 0 0 0) - (progn (set-zero *intvec-1*) (data *intvec-1*))) + (letm ((intvec (vector-fixnum 4))) + (set-zero intvec) + (data intvec))) (lisp-unit:assert-equalp ;set-all #(44 44 44 44) - (progn (set-all *intvec-1* 44) (data *intvec-1*))) + (letm ((intvec (vector-fixnum 4))) + (set-all intvec 44) + (data intvec))) (lisp-unit:assert-equalp ;set-basis #(0 1 0 0) - (progn (set-basis *intvec-1* 1) (data *intvec-1*))) + (letm ((intvec (vector-fixnum 4))) + (set-basis intvec 1) + (data intvec))) (lisp-unit:assert-equalp ;vector-reverse #(4 3 2 1) - (progn - (setf (data *intvec-1*) #(1 2 3 4)) - (vector-reverse *intvec-1*) (data *intvec-1*))) + (letm ((intvec (vector-fixnum #(1 2 3 4)))) + (vector-reverse intvec) + (data intvec))) (lisp-unit:assert-eql ;gsl-min -12 - (progn - (setf (data *intvec-1*) #(-1 -12 8 3)) - (gsl-min *intvec-1*))) + (letm ((intvec (vector-fixnum #(-1 -12 8 3)))) + (gsl-min intvec))) (lisp-unit:assert-eql ;gsl-max 8 - (progn - (setf (data *intvec-1*) #(-1 -12 8 3)) - (gsl-max *intvec-1*))) + (letm ((intvec (vector-fixnum #(-1 -12 8 3)))) + (gsl-max intvec))) (lisp-unit:assert-equal ;gsl-minmax '(-12 8) - (progn - (setf (data *intvec-1*) #(-1 -12 8 3)) - (multiple-value-list (gsl-minmax *intvec-1*)))) + (letm ((intvec (vector-fixnum #(-1 -12 8 3)))) + (multiple-value-list (gsl-minmax intvec)))) (lisp-unit:assert-eql ;gsl-min-index 1 - (progn - (setf (data *intvec-1*) #(-1 -12 8 3)) - (gsl-min-index *intvec-1*))) + (letm ((intvec (vector-fixnum #(-1 -12 8 3)))) + (gsl-min-index intvec))) (lisp-unit:assert-eql ;gsl-max-index 2 - (progn - (setf (data *intvec-1*) #(-1 -12 8 3)) - (gsl-max-index *intvec-1*))) + (letm ((intvec (vector-fixnum #(-1 -12 8 3)))) + (gsl-max-index intvec))) (lisp-unit:assert-equal ;gsl-minmax-index '(1 2) - (progn - (setf (data *intvec-1*) #(-1 -12 8 3)) - (multiple-value-list (gsl-minmax-index *intvec-1*)))) + (letm ((intvec (vector-fixnum #(-1 -12 8 3)))) + (multiple-value-list (gsl-minmax-index intvec)))) (lisp-unit:assert-equalp ;copy #(1 2 3 4) - (progn - (setf (data *intvec-1*) #(1 2 3 4)) - (copy *intvec-2* *intvec-1*) (data *intvec-2*))) + (letm ((intvec1 (vector-fixnum #(1 2 3 4))) + (intvec2 (vector-fixnum 4))) + (copy intvec2 intvec1) + (data intvec2))) (lisp-unit:assert-equalp ;swap #(5 6 7 8 1 2 3 4) - (progn - (setf (data *intvec-1*) #(1 2 3 4) - (data *intvec-2*) #(5 6 7 8)) - (swap *intvec-1* *intvec-2*) - (concatenate 'vector (data *intvec-1*) (data *intvec-2*)))) + (letm ((intvec1 (vector-fixnum #(1 2 3 4))) + (intvec2 (vector-fixnum #(5 6 7 8)))) + (swap intvec2 intvec1) + (concatenate 'vector (data intvec1) (data intvec2)))) (lisp-unit:assert-equalp ;swap-elements #(1 4 3 2) - (progn - (setf (data *intvec-1*) #(1 2 3 4)) - (swap-elements *intvec-1* 1 3) - (data *intvec-1*)))) - -;;;;**************************************************************************** -;;;; Examples -;;;;**************************************************************************** - -#| -(with-data (vec vector-double 3) - (setf (gsl-aref vec 0) -3.21d0 - (gsl-aref vec 1) 1.0d0 - (gsl-aref vec 2) 12.8d0 - (cl-invalid vec) t) - (data vec)) - -(with-data (vec vector-double 3) - (setf (data vec) #(-3.21d0 1.0d0 12.8d0)) - (data vec)) - -(defparameter vec (make-data 'vector nil 3)) -(setf (data vec) #(-3.21d0 1.0d0 12.8d0)) -(free vec) - -(with-data (vec vector-double 3) - (setf (data vec) #(-3.21d0 1.0d0 12.8d0)) - (data vec)) - -(letm ((vec (vector-double 3))) - (setf (data vec) #(-3.21d0 1.0d0 12.8d0)) - (data vec)) - -(letm ((vec (vector-double #(-3.21d0 1.0d0 12.8d0)))) - (data vec)) - -(letm ((vec (vector-double '(-3.21d0 1.0d0 12.8d0)))) - (data vec)) - - - -(with-data (vec vector 3) (set-basis vec 1) - (format t "~&~a ~a ~a" - (gsl-aref vec 0) (gsl-aref vec 1) (gsl-aref vec 2))) - -;;; broken -(with-data (vec vector-double 3) - (setf (gsl-aref vec 0) -3.21d0 - (gsl-aref vec 1) 1.0d0 - (gsl-aref vec 2) 12.8d0) - (subvector vec 1 2)) - -(with-data (vec1 vector-double 3) - (with-data (vec2 vector-double 3) - (setf (gsl-aref vec1 0) -3.21d0 - (gsl-aref vec1 1) 1.0d0 - (gsl-aref vec1 2) 12.8d0) - (vector-copy vec2 vec1) - (data vec2))) - -|# + (letm ((intvec (vector-fixnum #(1 2 3 4)))) + (swap-elements intvec 1 3) + (data intvec)))) + +(lisp-unit:define-test vector-double + (lisp-unit:assert-equal + '("-0.321000000000d+01" "0.100000000000d+01" "0.128000000000d+02") + (lisp-unit:fp-sequence + (letm ((vec (vector-double 3))) + (setf (gsl-aref vec 0) -3.21d0 + (gsl-aref vec 1) 1.0d0 + (gsl-aref vec 2) 12.8d0 + (cl-invalid vec) t) + (data vec))) + (lisp-unit:assert-equal + '("-0.321000000000d+01" "0.100000000000d+01" "0.128000000000d+02") + (lisp-unit:fp-sequence + (letm ((vec (vector-double 3))) + (setf (data vec) #(-3.21d0 1.0d0 12.8d0)) + (data vec)))) + (lisp-unit:assert-equal + '("-0.321000000000d+01" "0.100000000000d+01" "0.128000000000d+02") + (lisp-unit:fp-sequence + (letm ((vec (vector-double #(-3.21d0 1.0d0 12.8d0)))) + (data vec)))) + (lisp-unit:assert-equal + '("0.000000000000d+01" "0.100000000000d+01" "0.000000000000d+01" + "0.000000000000d+01" "0.000000000000d+01") + (lisp-unit:fp-sequence + (letm ((base (vector-double 5))) + (set-basis base 1) + (data base)))) + (lisp-unit:assert-equal + '("-0.321000000000d+01" "0.100000000000d+01" "0.128000000000d+02") + (lisp-unit:fp-sequence + (letm ((vec1 (vector-double #(-3.21d0 1.0d0 12.8d0))) + (vec2 (vector-double 3))) + (copy vec2 vec1) + (data vec2)))))) diff --git a/gsll.asd b/gsll.asd index 769e84fa..74634ddd 100644 --- a/gsll.asd +++ b/gsll.asd @@ -1,6 +1,6 @@ ;; Definition of GSLL system ;; Liam Healy -;; Time-stamp: <2008-02-03 22:30:09EST gsll.asd> +;; Time-stamp: <2008-02-05 22:37:29EST gsll.asd> ;; $Id: $ (asdf:defsystem "gsll" @@ -174,4 +174,4 @@ (:file "minimization-one" :depends-on (init general)) (:file "roots-multi" :depends-on (init general data roots-one)) (:file "minimization-multi" :depends-on (init general data)) - (:file "linear-least-squares" :depends-on (init general data)))) + (:file "linear-least-squares" :depends-on (init general data random)))) diff --git a/histogram/updating-accessing.lisp b/histogram/updating-accessing.lisp index 7e340f5a..dcfcd082 100644 --- a/histogram/updating-accessing.lisp +++ b/histogram/updating-accessing.lisp @@ -155,7 +155,7 @@ (increment histo 2.7d0) (increment histo 6.9d0 2.0d0) (gsl-aref histo 16))) - (lisp-unit:assert-first-fp-equal + (lisp-unit:assert-equal '("0.000000000000d+01" "0.100000000000d+02") (lisp-unit:fp-values (letm ((histo (histogram 10))) diff --git a/polynomial.lisp b/polynomial.lisp index 0998c598..3274e597 100644 --- a/polynomial.lisp +++ b/polynomial.lisp @@ -1,6 +1,6 @@ ;; Polynomials ;; Liam Healy, Tue Mar 21 2006 - 18:33 -;; Time-stamp: <2008-02-03 15:07:32EST polynomial.lisp> +;; Time-stamp: <2008-02-05 22:35:20EST polynomial.lisp> ;; $Id: $ (in-package :gsl) @@ -44,7 +44,7 @@ (yad (vector-double ya))) (divided-difference-int (make-data 'vector-double nil (length xa)) - xad yad))))) + xad yad))) (defun-gsl polynomial-eval-divided-difference (dd xa x) "gsl_poly_dd_eval" diff --git a/wavelet.lisp b/wavelet.lisp index 5f02bbff..9a82e641 100644 --- a/wavelet.lisp +++ b/wavelet.lisp @@ -1,6 +1,6 @@ ;; Wavelet transforms. ;; Liam Healy, Mon Nov 26 2007 - 20:43 -;; Time-stamp: <2008-02-03 16:59:39EST wavelet.lisp> +;; Time-stamp: <2008-02-05 22:40:07EST wavelet.lisp> ;; $Id: $ (in-package :gsl) @@ -14,7 +14,7 @@ ;;; Utility (defun forward-backward (symb) - (if (string-equal :symb backward) -1 1) + (if (string-equal symb :backward) -1 1)) ;;;;**************************************************************************** ;;;; Allocation of wavelets -- GitLab