Commit b40b3238 authored by liam's avatar liam
Browse files

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
parent 3467a214
;********************************************************
; 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))))))
;; 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
;;;;****************************************************************************
......
;; 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)))))
;; 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