Commit 4729f28f authored by liam's avatar liam

Changed meaning of #'defun-gsl-all arguments so that the first

argument should be a list of element types by themselves
(e.g. 'double) and not the data type and element type
('vector-double).  Hardwire *data-name-alist* to associate these
symbols with the GSL convention for words that are insterted in
strings (e.g. (FIXNUM . "_int")).  #'make-symbol-from-strings replaces
#'data-object-name in new file utility.lisp and splice-name just
inserts, doesn't remove anything.  These changes permit the definition
of #'defun-gsl-stats to be defined using #'defun-gsl-all.  Created
mean-variance.lisp.  Created shuffling-sampling.lisp, which does not
deal directly with CL objects yet.  Fix broken example in vector.lisp.


git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3158 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
parent bdffb15c
......@@ -3,7 +3,7 @@
; description: Using GSL storage.
; date: Sun Mar 26 2006 - 16:32
; author: Liam M. Healy
; modified: Sat Jun 3 2006 - 20:43
; modified: Sun Dec 3 2006 - 10:24
;********************************************************
;;; $Id: $
......@@ -87,9 +87,6 @@
;;;; Macro defdata to define class etc.
;;;;****************************************************************************
(defun data-object-name (string)
(intern (format nil "GSL-~:@(~a~)" (string string))))
(defun assign-pointer (object pointer)
"Check that a GSL data pointer is not null, then assign it to the object."
(check-null-pointer
......@@ -103,7 +100,11 @@
;;; (args (loop for i below dimensions collect (intern (format nil "I~d" i))))
;;; (mapcar (lambda (v) `(,v :size)) args)
(defvar *data-name-alist* nil)
(defparameter *data-name-alist*
'((FIXNUM . "_int")
(SINGLE . "_float")
(DOUBLE . "")
(COMPLEX . "_complex")))
(defmacro defdata
(c-string cl-symbol cl-base-type
......@@ -118,10 +119,8 @@
(format nil "gsl_~a_~a" c-string function-name)))
(let* ((cargs (loop for i below dimensions
collect `((nth ,i (storage-size object)) :size)))
(object-name (data-object-name cl-symbol)))
(object-name (make-symbol-from-strings *gsl-prefix* cl-symbol)))
`(progn
(eval-when (:compile-toplevel :load-toplevel :execute)
(setf *data-name-alist* (acons ',cl-symbol ,c-string *data-name-alist*)))
(defclass ,object-name (,superclass)
((cl-base-type :initform ',cl-base-type :reader cl-base-type
:allocation :class)))
......@@ -154,18 +153,17 @@
((stream :pointer) ((pointer object) :pointer) (format :string))
:type :method)))))
(defun splice-name (base-name remove symbol)
(defun splice-name (base-name keyword symbol)
"Make a new C name for a data function from a base name."
(let* ((start (search remove base-name))
(end (+ start (length remove))))
(let* ((insert (+ (search keyword base-name) (length keyword))))
(concatenate 'string
(subseq base-name 0 start)
(subseq base-name 0 insert)
(rest (assoc symbol *data-name-alist*))
(subseq base-name end))))
(subseq base-name insert))))
;;; (splice-name "gsl_vector_get" "vector" 'vector-fixnum)
;;; "gsl_vector_int_get"
;;; (data-object-name 'vector-fixnum)
;;; (make-symbol-from-strings *gsl-prefix* 'vector-fixnum)
;;; GSL-VECTOR-FIXNUM
(defun defun-gsl-all (types ctypes string general-class args)
......@@ -179,7 +177,8 @@
,(mapcar
(lambda (x)
(if (and (listp x) (eq (second x) general-class))
(list (first x) (data-object-name type))
(list (first x)
(make-symbol-from-strings general-class type))
x))
(second args))
;; Create the correct GSL C library function name
......@@ -219,7 +218,7 @@
memory when done."
(let ((obj
(make-instance
(data-object-name type)
(make-symbol-from-strings *gsl-prefix* type)
:storage-size size)))
(if zero (calloc obj) (alloc obj))
obj))
......
......@@ -3,7 +3,7 @@
; description: Matrices
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Fri Jul 7 2006 - 23:17
; modified: Sun Dec 3 2006 - 18:53
;********************************************************
;;; $Id: $
......@@ -33,7 +33,7 @@
(defmacro defun-gsl-mdsfc (&rest args)
"A defun-gsl for matrices of double, single, fixnum, and complex."
(defun-gsl-all
'(matrix-double matrix-single matrix-fixnum matrix-complex)
'(double single fixnum complex)
'(:double :float :int gsl-complex)
"matrix"
'gsl-matrix
......@@ -42,7 +42,7 @@
(defmacro defun-gsl-mdsf (&rest args)
"A defun-gsl for matrices of double, single, and fixnum."
(defun-gsl-all
'(matrix-double matrix-single matrix-fixnum)
'(double single fixnum)
'(:double :float :int)
"matrix"
'gsl-matrix
......@@ -168,7 +168,7 @@
"A defun-gsl for vectors of double, single, fixnum, and complex,
translating to a GSL function named matrix_*."
(defun-gsl-all
'(matrix-double matrix-single matrix-fixnum matrix-complex)
'(double single fixnum complex)
'(:double :float :int gsl-complex)
"matrix"
'gsl-vector
......
......@@ -3,7 +3,7 @@
; description: Vectors
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Sat Nov 11 2006 - 23:20
; modified: Sun Dec 3 2006 - 18:44
;********************************************************
;;; $Id: $
......@@ -56,7 +56,7 @@ deallocated with the vector.
(defmacro defun-gsl-vdsfc (&rest args)
"A defun-gsl for vectors of double, single, fixnum, and complex."
(defun-gsl-all
'(vector-double vector-single vector-fixnum vector-complex)
'(double single fixnum complex)
'(:double :float :int gsl-complex)
"vector"
'gsl-vector
......@@ -65,7 +65,7 @@ deallocated with the vector.
(defmacro defun-gsl-vdsf (&rest args)
"A defun-gsl for vectors of double, single, and fixnum."
(defun-gsl-all
'(vector-double vector-single vector-fixnum)
'(double single fixnum)
'(:double :float :int)
"vector"
'gsl-vector
......@@ -421,12 +421,12 @@ same length.")
;;;;****************************************************************************
#|
(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)
(data vec))
(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))
......@@ -436,17 +436,10 @@ same length.")
(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))
(with-data (vec vector-double 3)
(set-all vec 77.8d0)
(print-vector vec)
(set-zero vec)
(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)))
......
......@@ -3,7 +3,7 @@
; description: Definition of GSLL system
; date:
; author: Liam Healy
; modified: Sat Nov 25 2006 - 23:01
; modified: Sun Dec 3 2006 - 21:58
;********************************************************
;;; $Id: $
......@@ -18,6 +18,7 @@
((:module init
:components
((:file "init")
(:file "utility" :depends-on (init))
(:file "structures" :depends-on (init))
(:file "interface" :depends-on (init))
;; http://www.cs.northwestern.edu/academics/courses/325/readings/lisp-unit.html
......@@ -123,8 +124,13 @@
(:file "poisson" :depends-on (rng-types))
(:file "bernoulli" :depends-on (rng-types))
(:file "binomial" :depends-on (rng-types))
(:file "multnomial" :depends-on (rng-types))
(:file "multinomial" :depends-on (rng-types))
(:file "negative-binomial" :depends-on (rng-types))
(:file "geometric" :depends-on (rng-types))
(:file "hypergeometric" :depends-on (rng-types))
(:file "logarithmic" :depends-on (rng-types))))))
(:file "logarithmic" :depends-on (rng-types))
(:file "shuffling-sampling" :depends-on (rng-types))))
(:module statistics
:depends-on (init data)
:components
((:file "mean-variance")))))
;********************************************************
; file: utility.lisp
; description: Utility definitions
; date: Sun Dec 3 2006 - 10:21
; author: Liam M. Healy
; modified: Sun Dec 3 2006 - 10:22
;********************************************************
;;; $Id: $
(in-package :gsl)
(defun make-symbol-from-strings (&rest strings)
"Construct a symbol by concatenating words with hyphens."
(intern (format nil "~{~:@(~a~)~^-~}" (mapcar #'string strings))))
(defparameter *gsl-prefix* 'gsl)
;********************************************************
; file: shuffling-sampling.lisp
; description: Shuffling and sampling
; date: Sat Dec 2 2006 - 18:40
; author: Liam M. Healy
; modified: Sat Dec 2 2006 - 18:55
;********************************************************
;;; $Id: $
(in-package :gsl)
;;; These are defined for sequences of memory locations and
;;; so are difficult to adapt to arbitrary CL objects.
;;; The interfaces will probably change.
(defun-gsl shuffle (generator base n size)
"gsl_ran_shuffle"
(((generator generator) :pointer) (base :pointer) (n :size) (size :size))
:c-return :void
:documentation
"Randomly shuffle the order of @var{n} objects, each of
size @var{size}, stored in the array @var{base}[0..@var{n}-1]. The
output of the random number generator @var{r} is used to produce the
permutation. The algorithm generates all possible @math{n!}
permutations with equal probability, assuming a perfect source of random
numbers.")
(defun-gsl choose-random (generator dest k src n size)
"gsl_ran_choose"
(((generator generator) :pointer)
(dest :pointer) (k :size) (src :pointer) (n :size) (size :size))
;; This is described in the GSL docs as returning int, but it does
;; not say what the return value means. Therefore, we ignore it.
:c-return :void
:documentation
"Fill the array @var{dest}[k] with @var{k} objects taken
randomly from the @var{n} elements of the array
@var{src}[0..@var{n}-1]. The objects are each of size @var{size}. The
output of the random number generator @var{r} is used to make the
selection. The algorithm ensures all possible samples are equally
likely, assuming a perfect source of randomness.
The objects are sampled @emph{without} replacement, thus each object can
only appear once in @var{dest}[k]. It is required that @var{k} be less
than or equal to @code{n}. The objects in @var{dest} will be in the
same relative order as those in @var{src}. You will need to call
@code{gsl_ran_shuffle(r, dest, n, size)} if you want to randomize the
order.")
(defun-gsl sample (generator dest k src n size)
"gsl_ran_sample"
(((generator generator) :pointer)
(dest :pointer) (k :size) (src :pointer) (n :size) (size :size))
:c-return :void
:documentation
"Like #'choose-random, but samples @var{k} items
from the original array of @var{n} items @var{src} with replacement, so
the same object can appear more than once in the output sequence
@var{dest}. There is no requirement that @var{k} be less than @var{n}
in this case.")
;********************************************************
; file: mean-variance.lisp
; description: Mean, standard deviation, and variance
; date: Sat Dec 2 2006 - 22:15
; author: Liam M. Healy
; modified: Sun Dec 3 2006 - 18:18
;********************************************************
;;; $Id: $
(in-package :gsl)
;;; To do: stride other than 1 when that information is availble from
;;; the vector.
(defmacro defun-gsl-stats (&rest args)
"A defun-gsl for stats of double, single, and fixnum."
(defun-gsl-all
'(double single fixnum)
'(:double :float :int)
"stats"
'gsl-vector
args))
(defgeneric mean (gsl-vector)
(:documentation "The arithmetic mean of the vector.
The arithmetic mean, or sample mean, is denoted by
@math{\Hat\mu} and defined as
\Hat\mu = (1/N) \sum x_i. Returns a double-float."))
(defun-gsl-stats mean ((vector gsl-vector))
"gsl_stats_mean"
(((gsl-array vector) :pointer) (1 :int) ((dim0 vector) :size))
:c-return :double)
(defgeneric variance (gsl-vector)
(:documentation "The estimated, or @dfn{sample}, variance of
@var{data}, a dataset of length @var{n} with stride @var{stride}. The
estimated variance is denoted by @math{\Hat\sigma^2} and is defined by
\Hat\sigma^2 = (1/(N-1)) \sum (x_i - \Hat\mu)^2
where @math{x_i} are the elements of the dataset @var{data}. Note that
the normalization factor of @math{1/(N-1)} results from the derivation
of @math{\Hat\sigma^2} as an unbiased estimator of the population
variance @math{\sigma^2}. For samples drawn from a gaussian distribution
the variance of @math{\Hat\sigma^2} itself is @math{2 \sigma^4 / N}.
This function computes the mean via a call to #'mean. If
you have already computed the mean then you can pass it directly to
#'variance-m"))
(defun-gsl-stats variance ((vector gsl-vector))
"gsl_stats_variance"
(((gsl-array vector) :pointer) (1 :int) ((dim0 vector) :size))
:c-return :double)
(defgeneric variance-m (gsl-vector mean)
(:documentation "Compute the variance with the mean known to
avoid its recomputation."))
(defun-gsl-stats variance-m ((vector gsl-vector) mean)
"gsl_stats_variance_m"
(((gsl-array vector) :pointer) (1 :int)
((dim0 vector) :size) (mean :double))
:c-return :double)
(defgeneric standard-deviation (gsl-vector)
(:documentation "The standard deviation, square root of the variance."))
(defun-gsl-stats standard-deviation ((vector gsl-vector))
"gsl_stats_sd"
(((gsl-array vector) :pointer) (1 :int) ((dim0 vector) :size))
:c-return :double)
(defgeneric standard-deviation-m (gsl-vector mean)
(:documentation "The standard deviation with the mean known to
avoid its recomputation."))
(defun-gsl-stats standard-deviation-m ((vector gsl-vector) mean)
"gsl_stats_sd_m"
(((gsl-array vector) :pointer) (1 :int)
((dim0 vector) :size) (mean :double))
:c-return :double)
(defgeneric variance-with-fixed-mean (gsl-vector mean)
(:documentation
"An unbiased estimate of the variance of
@var{data} when the population mean @var{mean} of the underlying
distribution is known @emph{a priori}. In this case the estimator for
the variance uses the factor @math{1/N} and the sample mean
@math{\Hat\mu} is replaced by the known population mean @math{\mu},
\Hat\sigma^2 = (1/N) \sum (x_i - \mu)^2."))
(defun-gsl-stats variance-with-fixed-mean ((vector gsl-vector) mean)
"gsl_stats_variance_with_fixed_mean"
(((gsl-array vector) :pointer) (1 :int) ((dim0 vector) :size)
(mean :double))
:c-return :double)
(defgeneric standard-deviation-with-fixed-mean (gsl-vector mean)
(:documentation
"The standard deviation of @var{data} for a fixed population
mean @var{mean}. The result is the square root of the
corresponding variance function."))
(defun-gsl-stats standard-deviation-with-fixed-mean
((vector gsl-vector) mean)
"gsl_stats_sd_with_fixed_mean"
(((gsl-array vector) :pointer) (1 :int) ((dim0 vector) :size)
(mean :double))
:c-return :double)
;;; Examples and unit test
(lisp-unit:define-test mean-variance
(lisp-unit:assert-equal
'("0.353000000000d+01" "0.688807000000d+02" "0.688807000000d+02"
"0.829943974013d+01" "0.829943974013d+01" "0.461413666667d+02"
"0.679274367739d+01")
(with-data (vec vector-double 3)
(setf (data vec) #(-3.21d0 1.0d0 12.8d0))
(let ((mean (mean vec)))
(lisp-unit:fp-sequence
(list
mean
(variance vec)
(variance-m vec mean)
(standard-deviation vec)
(standard-deviation-m vec mean)
(variance-with-fixed-mean vec 4.0d0)
(standard-deviation-with-fixed-mean vec 4.0d0)))))
(lisp-unit:assert-equal
'("0.333333333333d+01" "0.253333333333d+02" "0.253333333333d+02"
"0.503322295685d+01" "0.503322295685d+01" "0.173333333333d+02"
"0.416333199893d+01")
(with-data (vec vector-fixnum 3)
(setf (data vec) #(8 4 -2))
(let ((mean (mean vec)))
(lisp-unit:fp-sequence
(list
mean
(variance vec)
(variance-m vec mean)
(standard-deviation vec)
(standard-deviation-m vec mean)
(variance-with-fixed-mean vec 4.0d0)
(standard-deviation-with-fixed-mean vec 4.0d0))))))))
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