Commit ef8f5ab0 authored by Liam Healy's avatar Liam Healy

Histogram enabled ffa

Little actual ffa usage, just the port to 'sizet, method and use of
#'mpointer in the histogram context.  It would be nice to be able to
adapt defmfun to discriminating between 1d and 2d histograms rather
than using histo-1d2d, but I will put that off for now.  This compiles
but is not tested.
parent 6698e65b
;; Data using ffa
;; Liam Healy 2008-04-06 21:23:41EDT data-ffa.lisp
;; Time-stamp: <2008-08-16 20:00:37EDT data.lisp>
;; Time-stamp: <2008-08-17 09:59:05EDT data.lisp>
;; $Id$
(in-package :gsl)
......@@ -277,11 +277,11 @@
(cffi:mem-aref pointer cffi-type pointer-index)
(cffi:mem-aref pointer cffi-type (1+ pointer-index)))))))
(defun maref (object &rest indices)
"An element of the data."
(copy-c-to-cl object)
(apply 'aref (cl-array object) indices))
(defgeneric maref (object &rest indices)
(:documentation "An element of the data.")
(:method ((object gsl-data) &rest indices)
(copy-c-to-cl object)
(apply 'aref (cl-array object) indices)))
;;; Alternative to complete copy is to mark which elements have
;;; changed and just copy them. Is it worth it?
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2008-08-16 20:05:07EDT gsll.asd>
;; Time-stamp: <2008-08-17 09:39:54EDT gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -145,7 +145,6 @@
(:file "covariance")
;; minimum and maximum values provided in vector.lisp
(:file "median-percentile")))
#+no
(:module histogram
:depends-on (init)
:components
......
;; The histogram structure
;; Liam Healy, Mon Jan 1 2007 - 11:32
;; Time-stamp: <2008-02-19 22:33:01EST histogram.lisp>
;; Time-stamp: <2008-08-17 09:02:00EDT histogram.lisp>
;; $Id$
(in-package :gsl)
......@@ -20,7 +20,7 @@
(defclass histogram ()
((pointer
:initarg :pointer :accessor pointer
:initarg :pointer :accessor mpointer
:documentation "A C pointer to the GSL representation of the histogram.")
(number-of-bins :initarg :number-of-bins :accessor number-of-bins))
(:documentation
......@@ -28,7 +28,7 @@
(defmfun alloc-histo-1 (object)
"gsl_histogram_alloc"
(((number-of-bins object) size))
(((number-of-bins object) sizet))
:export nil
:index (letm histogram)
:c-return (cr :pointer)
......@@ -36,8 +36,8 @@
(defmfun alloc-histo-2 (object)
"gsl_histogram2d_alloc"
(((first (number-of-bins object)) size)
((second (number-of-bins object)) size))
(((first (number-of-bins object)) sizet)
((second (number-of-bins object)) sizet))
:export nil
:index (letm histogram)
:c-return (cr :pointer)
......@@ -78,7 +78,7 @@
(defmfun set-ranges-1 (histogram ranges)
"gsl_histogram_set_ranges"
(((pointer histogram) :pointer)
((gsl-array ranges) :pointer) ((dim0 ranges) size))
((c-pointer ranges) :pointer) ((dim0 ranges) sizet))
:export nil
:index (letm histogram)
:documentation ; FDL
......@@ -91,8 +91,8 @@
(defmfun set-ranges-2 (histogram x-ranges y-ranges)
"gsl_histogram2d_set_ranges"
(((pointer histogram) :pointer)
((gsl-array x-ranges) :pointer) ((dim0 x-ranges) size)
((gsl-array y-ranges) :pointer) ((dim0 y-ranges) size))
((c-pointer x-ranges) :pointer) ((dim0 x-ranges) sizet)
((c-pointer y-ranges) :pointer) ((dim0 y-ranges) sizet))
:export nil
:index (letm histogram))
......
;; N-tuples
;; Liam Healy Sat Feb 3 2007 - 12:53
;; Time-stamp: <2008-02-17 18:39:48EST ntuple.lisp>
;; Time-stamp: <2008-08-17 09:39:34EDT ntuple.lisp>
;; $Id$
(in-package :gsl)
......@@ -11,7 +11,7 @@
;;; Writing a file
(defmfun create-ntuple (filename data size)
"gsl_ntuple_create"
((filename :string) (data :pointer) (size size))
((filename :string) (data :pointer) (size sizet))
:c-return :pointer
:documentation ; FDL
"Create a new write-only ntuple file filename for
......@@ -24,7 +24,7 @@
;;; Reading a file
(defmfun open-ntuple (filename data size)
"gsl_ntuple_create"
((filename :string) (data :pointer) (size size))
((filename :string) (data :pointer) (size sizet))
:c-return :pointer
:documentation ; FDL
"Open an existing ntuple file filename for reading
......
;; Histogram operations
;; Liam Healy, Mon Jan 1 2007 - 16:47
;; Time-stamp: <2008-02-23 18:57:17EST operations.lisp>
;; Time-stamp: <2008-08-17 09:34:52EDT operations.lisp>
;; $Id$
(in-package :gsl)
(defmfun equal-bins-p-1 (histogram1 histogram2)
"gsl_histogram_equal_bins_p"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:c-return :true-false
:export nil
:index equal-bins-p
......@@ -16,7 +16,7 @@
(defmfun equal-bins-p-2 (histogram1 histogram2)
"gsl_histogram2d_equal_bins_p"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:c-return :true-false
:export nil
:index equal-bins-p
......@@ -32,7 +32,7 @@
;;; C function means; assumed to be error code.
(defmfun m+-1 (histogram1 histogram2)
"gsl_histogram_add"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m+
:documentation ; FDL
......@@ -45,7 +45,7 @@
;;; C function means; assumed to be error code.
(defmfun m+-2 (histogram1 histogram2)
"gsl_histogram2d_add"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m+
:documentation ; FDL
......@@ -66,7 +66,7 @@
;;; C function means; assumed to be error code.
(defmfun m--1 (histogram1 histogram2)
"gsl_histogram_sub"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m-
:documentation ; FDL
......@@ -78,7 +78,7 @@
;;; C function means; assumed to be error code.
(defmfun m--2 (histogram1 histogram2)
"gsl_histogram2d_sub"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m-
:documentation ; FDL
......@@ -97,7 +97,7 @@
;;; C function means; assumed to be error code.
(defmfun m*-1 (histogram1 histogram2)
"gsl_histogram_mul"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m*
:documentation ; FDL
......@@ -110,7 +110,7 @@
;;; C function means; assumed to be error code.
(defmfun m*-2 (histogram1 histogram2)
"gsl_histogram2d_mul"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m*
:documentation ; FDL
......@@ -131,7 +131,7 @@
;;; C function means; assumed to be error code.
(defmfun m/-1 (histogram1 histogram2)
"gsl_histogram_div"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m/
:documentation ; FDL
......@@ -144,7 +144,7 @@
;;; C function means; assumed to be error code.
(defmfun m/-2 (histogram1 histogram2)
"gsl_histogram2d_div"
(((pointer histogram1) :pointer) ((pointer histogram2) :pointer))
(((mpointer histogram1) :pointer) ((mpointer histogram2) :pointer))
:export nil
:index m/
:documentation ; FDL
......@@ -165,7 +165,7 @@
;;; C function means; assumed to be error code.
(defmfun scale-1 (histogram scale)
"gsl_histogram_scale"
(((pointer histogram) :pointer) (scale :double))
(((mpointer histogram) :pointer) (scale :double))
:export nil
:index scale
:documentation ; FDL
......@@ -176,7 +176,7 @@
;;; C function means; assumed to be error code.
(defmfun scale-2 (histogram scale)
"gsl_histogram2d_scale"
(((pointer histogram) :pointer) (scale :double))
(((mpointer histogram) :pointer) (scale :double))
:export nil
:index scale
:documentation ; FDL
......@@ -194,7 +194,7 @@
;;; C function means; assumed to be error code.
(defmfun shift-1 (histogram offset)
"gsl_histogram_shift"
(((pointer histogram) :pointer) (offset :double))
(((mpointer histogram) :pointer) (offset :double))
:export nil
:index shift
:documentation ; FDL
......@@ -205,7 +205,7 @@
;;; C function means; assumed to be error code.
(defmfun shift-2 (histogram offset)
"gsl_histogram2d_shift"
(((pointer histogram) :pointer) (offset :double))
(((mpointer histogram) :pointer) (offset :double))
:export nil
:index shift
:documentation ; FDL
......
;; Histogram probability distribution.
;; Liam Healy, Mon Jan 1 2007 - 17:51
;; Time-stamp: <2008-02-17 18:39:49EST probability-distribution.lisp>
;; Time-stamp: <2008-08-17 09:37:15EDT probability-distribution.lisp>
;; $Id$
(in-package :gsl)
(defclass histogram-pdf ()
((pointer
:initarg :pointer :accessor pointer
:initarg :pointer :accessor mpointer
:documentation
"A C pointer to the GSL representation of the histogram.")
(number-of-bins :initarg :number-of-bins :accessor number-of-bins))
......@@ -16,7 +16,7 @@
(defmfun alloc-1 (object)
"gsl_histogram_pdf_alloc"
(((number-of-bins object) size))
(((number-of-bins object) sizet))
:export nil
:index alloc
:c-return (cr :pointer)
......@@ -24,7 +24,7 @@
(defmfun alloc-2 (object)
"gsl_histogram2d_pdf_alloc"
(((number-of-bins object) size))
(((number-of-bins object) sizet))
:export nil
:index alloc
:c-return (cr :pointer)
......@@ -35,14 +35,14 @@
(defmfun free-1 (object)
"gsl_histogram_pdf_free"
(((pointer object) :pointer))
(((mpointer object) :pointer))
:export nil
:index free
:c-return :void)
(defmfun free-2 (object)
"gsl_histogram2d_pdf_free"
(((pointer object) :pointer))
(((mpointer object) :pointer))
:export nil
:index free
:c-return :void)
......@@ -52,7 +52,7 @@
(defmfun pdf-init-1 (pdf histogram)
"gsl_histogram_pdf_init"
(((pointer pdf) :pointer) ((pointer histogram) :pointer))
(((mpointer pdf) :pointer) ((mpointer histogram) :pointer))
:return ()
:export nil
:index pdf-init
......@@ -64,7 +64,7 @@
(defmfun pdf-init-2 (pdf histogram)
"gsl_histogram2d_pdf_init"
(((pointer pdf) :pointer) ((pointer histogram) :pointer))
(((mpointer pdf) :pointer) ((mpointer histogram) :pointer))
:return ()
:export nil
:index pdf-init
......@@ -84,7 +84,7 @@
(defmfun sample-1 (pdf value)
"gsl_histogram_pdf_sample"
(((pointer pdf) :pointer) (value :double))
(((mpointer pdf) :pointer) (value :double))
:c-return :double
:export nil
:index sample
......@@ -99,7 +99,7 @@
(defmfun sample-2 (pdf value)
"gsl_histogram2d_pdf_sample"
(((pointer pdf) :pointer) (value :double))
(((mpointer pdf) :pointer) (value :double))
:c-return :double
:export nil
:index sample
......
;; Reading and writing histograms.
;; Liam Healy 2008-02-17 17:11:23EST read-write.lisp
;; Time-stamp: <2008-02-17 17:13:15EST read-write.lisp>
;; Time-stamp: <2008-08-17 09:36:25EDT read-write.lisp>
;; $Id$
(in-package :gsl)
(defmfun write-binary-1 (object stream)
"gsl_histogram_fwrite"
((stream :pointer) ((pointer object) :pointer))
((stream :pointer) ((mpointer object) :pointer))
:export nil
:index write-binary)
(defmfun write-binary-2 (object stream)
"gsl_histogram2d_fwrite"
((stream :pointer) ((pointer object) :pointer))
((stream :pointer) ((mpointer object) :pointer))
:export nil
:index write-binary)
......@@ -22,13 +22,13 @@
(defmfun read-binary-1 (object stream)
"gsl_histogram_fread"
((stream :pointer) ((pointer object) :pointer))
((stream :pointer) ((mpointer object) :pointer))
:export nil
:index read-binary)
(defmfun read-binary-2 (object stream)
"gsl_histogram2d_fread"
((stream :pointer) ((pointer object) :pointer))
((stream :pointer) ((mpointer object) :pointer))
:export nil
:index read-binary)
......@@ -37,14 +37,14 @@
(defmfun write-formatted-1 (object stream format)
"gsl_histogram_fprintf"
((stream :pointer) ((pointer object) :pointer)
((stream :pointer) ((mpointer object) :pointer)
((first format) :string) ((second format) :string))
:export nil
:index write-formatted)
(defmfun write-formatted-2 (object stream format)
"gsl_histogram2d_fprintf"
((stream :pointer) ((pointer object) :pointer)
((stream :pointer) ((mpointer object) :pointer)
((first format) :string) ((second format) :string))
:export nil
:index write-formatted)
......@@ -73,13 +73,13 @@
(defmfun read-formatted-1 (object stream format)
"gsl_histogram_fscanf"
((stream :pointer) ((pointer object) :pointer))
((stream :pointer) ((mpointer object) :pointer))
:export nil
:index read-formatted)
(defmfun read-formatted-2 (object stream format)
"gsl_histogram2d_fscanf"
((stream :pointer) ((pointer object) :pointer))
((stream :pointer) ((mpointer object) :pointer))
:export nil
:index read-formatted)
......
;; Statistics of histograms.
;; Liam Healy, Mon Jan 1 2007 - 16:13
;; Time-stamp: <2008-02-17 17:07:06EST statistics.lisp>
;; Time-stamp: <2008-08-17 09:41:27EDT statistics.lisp>
;; $Id$
(in-package :gsl)
(defmfun gsl-max-1 (histogram)
(defmfun mmax-1 (histogram)
"gsl_histogram_max_val"
(((pointer histogram) :pointer))
:c-return :double
:export nil
:index gsl-max
:index mmax
:documentation ; FDL
"The maximum value contained in the histogram bins.")
(defmfun gsl-max-2 (histogram)
(defmfun mmax-2 (histogram)
"gsl_histogram2d_max_val"
(((pointer histogram) :pointer))
:c-return :double
:export nil
:index gsl-max
:index mmax
:documentation ; FDL
"The maximum value contained in the histogram bins.")
(defmethod gsl-max ((histogram histogram))
"The maximum value contained in the histogram bins."
(histo-1d2d histogram gsl-max))
(histo-1d2d histogram mmax))
(defmfun gsl-min-1 (histogram)
(defmfun mmin-1 (histogram)
"gsl_histogram_min_val"
(((pointer histogram) :pointer))
:c-return :double
:export nil
:index gsl-min
:index mmin
:documentation ; FDL
"The minimum value contained in the histogram bins.")
(defmfun gsl-min-2 (histogram)
(defmfun mmin-2 (histogram)
"gsl_histogram2d_min_val"
(((pointer histogram) :pointer))
:c-return :double
:export nil
:index gsl-min
:index mmin
:documentation ; FDL
"The minimum value contained in the histogram bins.")
(defmethod gsl-min ((histogram histogram)) ; FDL
"The minimum value contained in the histogram bins."
(histo-1d2d histogram gsl-min))
(histo-1d2d histogram mmin))
(defmfun gsl-max-index-1 (histogram)
(defmfun max-index-1 (histogram)
"gsl_histogram_max_bin"
(((pointer histogram) :pointer))
:c-return size
:c-return sizet
:export nil
:index gsl-max-index
:index max-index
:documentation ; FDL
"The index of the bin containing the maximum value. In the case
where several bins contain the same maximum value the smallest
index is returned.")
(defmfun gsl-max-index-2 (histogram)
(defmfun max-index-2 (histogram)
"gsl_histogram2d_max_bin"
(((pointer histogram) :pointer)
(xindex size) (yindex size))
:c-return size
(xindex sizet) (yindex sizet))
:c-return sizet
:export nil
:index gsl-max-index
:index max-index
:documentation ; FDL
"The indices of the bin containing the maximum value. In the case
where several bins contain the same maximum value the first bin
......@@ -75,31 +75,31 @@
(defmethod gsl-max-index (histogram)
(histo-1d2d histogram gsl-max-index))
(defmfun gsl-min-index-1 (histogram)
(defmfun min-index-1 (histogram)
"gsl_histogram_min_bin"
(((pointer histogram) :pointer))
:c-return size
:c-return sizet
:export nil
:index gsl-min-index
:index min-index
:documentation ; FDL
"The index of the bin containing the minimum value. In the case
where several bins contain the same minimum value the smallest
index is returned.")
(defmfun gsl-min-index-2 (histogram)
(defmfun min-index-2 (histogram)
"gsl_histogram2d_min_bin"
(((pointer histogram) :pointer)
(xindex size) (yindex size))
:c-return size
(xindex sizet) (yindex sizet))
:c-return sizet
:export nil
:index gsl-min-index
:index min-index
:documentation ; FDL
"The indices of the bin containing the minimum value. In the case
where several bins contain the same minimum value the first bin
found is returned.")
(defmethod gsl-min-index (histogram)
(histo-1d2d histogram gsl-min-index))
(defmethod min-index (histogram)
(histo-1d2d histogram min-index))
(defmfun mean-1 (histogram)
"gsl_histogram_mean"
......
;; Updating and accessing histogram elements.
;; Liam Healy, Mon Jan 1 2007 - 14:43
;; Time-stamp: <2008-03-27 23:09:26EDT updating-accessing.lisp>
;; Time-stamp: <2008-08-17 09:41:04EDT updating-accessing.lisp>
;; $Id$
(in-package :gsl)
(defmfun increment-fix (histogram value)
"gsl_histogram_increment"
(((pointer histogram) :pointer) (value :double))
:index increment
:export nil)
(defmfun increment-weight (histogram value weight)
"gsl_histogram_accumulate"
(((pointer histogram) :pointer) (value :double) (weight :double))
:index increment
:export nil)
(defun-optionals increment (histogram value &optional weight)
-fix -weight
;; FDL
"Update the histogram by adding the weight
(defmfun increment-fix (histogram value &optional weight)
("gsl_histogram_increment" "gsl_histogram_accumulate")
((((mpointer histogram) :pointer) (value :double))
(((mpointer histogram) :pointer) (value :double) (weight :double)))
:documentation
"Update the histogram by adding the weight
(which defaults to 1.0) to the
bin whose range contains the coordinate x.
......@@ -36,8 +26,8 @@
(defmfun maref ((histogram histogram) &rest i)
"gsl_histogram_get"
(((pointer histogram) :pointer) ((first i) size))
:type :method
(((pointer histogram) :pointer) ((first i) sizet))
:definition :method
:c-return :double
:documentation ; FDL
"Return the contents of the i-th bin of the histogram.
......@@ -46,7 +36,7 @@
(defmfun range (histogram i)
"gsl_histogram_get_range"
(((pointer histogram) :pointer) (i size)
(((pointer histogram) :pointer) (i sizet)
(lower :double) (upper :double))
:documentation ; FDL
"Find the upper and lower range limits of the i-th
......@@ -59,14 +49,14 @@
If i lies outside the valid range of indices for
the histogram, then the error :EDOM is signalled.")
(defmfun gsl-max-range (histogram)
(defmfun max-range (histogram)
"gsl_histogram_max"
(((pointer histogram) :pointer))
:c-return :double
:documentation ; FDL
"The maximum upper range limit of the histogram.")
(defmfun gsl-min-range (histogram)
(defmfun min-range (histogram)
"gsl_histogram_min"
(((pointer histogram) :pointer))
:c-return :double
......@@ -87,11 +77,11 @@
:documentation ; FDL
"Reset all the bins in the histogram to zero.")
(defmfun histogram-find-1 (histogram value)
"gsl_histogram_find"
(((pointer histogram) :pointer) (value :double) (bin size))
:export nil
:index histogram-find
(defmfun histogram-find (histogram x-value &optional y-value)
("gsl_histogram_find" "gsl_histogram2d_find")
((((mpointer histogram) :pointer) (x-value :double) (bin sizet))
(((mpointer histogram) :pointer) (x-value :double) (y-value :double)
(xbin sizet) (ybin sizet)))
:documentation ; FDL
"Finds the bin number which covers the coordinate value in
the histogram. The bin is located using a binary search. The
......@@ -102,23 +92,11 @@
the valid range of the histogram then the error :EDOM is
signalled.")
(defmfun histogram-find-2 (histogram x-value y-value)
"gsl_histogram2d_find"
(((pointer histogram) :pointer)
(x-value :double) (y-value :double)
(xbin size) (ybin size))
:export nil
:index histogram-find)
(export 'histogram-find)
(defun histogram-find (histogram &rest values)
(histo-1d2d histogram histogram-find
((first values))
((first values) (second values))))
#|
(letm ((histo (histogram 10))) ; should be a gsl-warning here, how to check?
(set-ranges-uniform histo 0.0d0 10.0d0)
(increment histo -2.0d0))
|#
;;; Examples and unit test
#|
......
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