Commit b40b3238 authored by liam's avatar liam

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)))))
This diff is collapsed.
;; 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))))
......@@ -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)))
......
;; 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"
......
;; 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
......
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