Commit 9f1f9900 authored by Liam Healy's avatar Liam Healy
Browse files

Hand expansion of project-ntuple; start writing ntuple example

In order to avoid or defer the complicated process of modifying
defmfun definitions to handle two cbstructs, the definition of
project-ntuple has been written by hand as a defun etc., by expanding
a simpler defmfun and making the necessary modifications and mergers
with an editor.  It has not yet been tested.  The test given in GSL
ntuple/test.c is partially ported to Lisp.
parent a7a5f644
;; N-tuples
;; Liam Healy Sat Feb 3 2007 - 12:53
;; Time-stamp: <2009-06-06 23:54:34EDT ntuple.lisp>
;; Time-stamp: <2009-06-10 22:52:05EDT ntuple.lisp>
;; $Id$
(in-package :gsl)
;;; /usr/include/gsl/gsl_ntuple.h
;;; This requires two callback structs in :callbacks.
;;; Writing a file
(defmfun create-ntuple (filename data size)
(defmfun create-ntuple (filename data foreign-type)
"gsl_ntuple_create"
((filename :string) (data :pointer) (size sizet))
((filename :string) (data :pointer)
((cffi:foreign-type-size foreign-type) sizet))
:c-return :pointer
:documentation ; FDL
"Create a new write-only ntuple file filename for
......@@ -24,9 +22,10 @@
in and out of the file.")
;;; Reading a file
(defmfun open-ntuple (filename data size)
(defmfun open-ntuple (filename data foreign-type)
"gsl_ntuple_create"
((filename :string) (data :pointer) (size sizet))
((filename :string) (data :pointer)
((cffi:foreign-type-size foreign-type) sizet))
:c-return :pointer
:documentation ; FDL
"Open an existing ntuple file filename for reading
......@@ -64,24 +63,67 @@
"Closes the ntuple file and frees its associated allocated memory.")
;;; Histogramming ntuple values
#|
;;; This the one function in GSL that requires two cbstructs. Rather
;;; than modify the entire defmfun apparatus to handle it, we just
;;; manually build the expansion below.
(defmfun project-ntuple (histogram ntuple value-function select-function)
"gsl_ntuple_project"
((histogram :pointer) (ntuple :pointer)
(valfn :pointer) (selfn :pointer))
:callbacks
(valfn fnstruct nil (function :pointer (:input :pointer) :slug))
;; (valfn fnstruct nil (value-function :pointer (:input :pointer) :slug))
;; Need a second cbstruct definition:
;;(selfn fnstruct nil (function :pointer (:input :pointer) :slug))
:callback-dynamic (nil (function))
(selfn fnstruct nil (select-function :pointer (:input :pointer) :slug))
;;:callback-dynamic (nil (value-function))
:callback-dynamic (nil (select-function))
:documentation ; FDL
"Update the histogram the ntuple
"Update the histogram from the ntuple
using the functions value-function and select-function. For each
ntuple row where the selection function select-function is non-zero the
corresponding value of that row is computed using the function
value-function and added to the histogram. Those ntuple rows where
select-function returns zero are ignored. New entries are added to
the histogram, so subsequent calls can be used to accumulate further
data in the same histogram.")
|#
(PROGN
(DEFUN PROJECT-NTUPLE (HISTOGRAM NTUPLE VALUE-FUNCTION SELECT-FUNCTION)
(DECLARE (SPECIAL PROJECT-NTUPLE-DYNFN0 PROJECT-NTUPLE-DYNFN1))
"Update the histogram from the ntuple
using the functions value-function and select-function. For each
ntuple row where the selection function select-function is non-zero the
corresponding value of that row is computed using the function
value-function and added to the histogram. Those ntuple rows where
select-function returns zero are ignored. New entries are added to
the histogram, so subsequent calls can be used to accumulate further
data in the same histogram.")
data in the same histogram."
(WITH-FOREIGN-OBJECTS ((VALFN 'FNSTRUCT) (SELFN 'fnstruct))
(SETF PROJECT-NTUPLE-DYNFN0
(MAKE-COMPILED-FUNCALLABLE
VALUE-FUNCTION
'(SELECT-FUNCTION :POINTER (:INPUT :POINTER) :SLUG) NIL (LIST))
PROJECT-NTUPLE-DYNFN1
(MAKE-COMPILED-FUNCALLABLE
SELECT-FUNCTION
'(SELECT-FUNCTION :POINTER (:INPUT :POINTER) :SLUG) NIL (LIST)))
(SET-CBSTRUCT VALFN 'FNSTRUCT NIL (LIST 'FUNCTION 'PROJECT-NTUPLE-CBFN0))
(SET-CBSTRUCT SELFN 'FNSTRUCT NIL (LIST 'FUNCTION 'PROJECT-NTUPLE-CBFN1))
(LET ((CRETURN
(FOREIGN-FUNCALL "gsl_ntuple_project" :POINTER
HISTOGRAM :POINTER NTUPLE
:POINTER VALFN :POINTER SELFN
:INT)))
(CHECK-GSL-STATUS CRETURN 'PROJECT-NTUPLE)
(VALUES))))
(DEFMCALLBACK PROJECT-NTUPLE-CBFN0 PROJECT-NTUPLE-DYNFN0
(VALUE-FUNCTION :POINTER (:INPUT :POINTER) :SLUG))
(DEFMCALLBACK PROJECT-NTUPLE-CBFN1 PROJECT-NTUPLE-DYNFN1
(SELECT-FUNCTION :POINTER (:INPUT :POINTER) :SLUG))
(MAP-NAME 'PROJECT-NTUPLE "gsl_ntuple_project")
(EXPORT 'PROJECT-NTUPLE))
;;; Callback definitions
......@@ -96,3 +138,26 @@
selected by the selection function which should return the value
to be added to the histogram."
|#
;;; Examples and unit test
;;; See gsl-1.11/ntuple/test.c
(defcstruct ntuple-data
(num :int)
(x :double)
(y :double)
(z :double))
(defun make-ntuple-example-data ()
(cffi:with-foreign-object (data 'ntuple-data)
(let ((ntuple (create-ntuple "test.dat" data 'ntuple-data)))
(dotimes (row 1000)
(let* ((xi (/ (+ row 1.5d0)))
(yi (expt xi 2))
(zi (expt xi 3)))
(setf (cffi:foreign-slot-value data 'ntuple-data 'num) row
(cffi:foreign-slot-value data 'ntuple-data 'x) xi
(cffi:foreign-slot-value data 'ntuple-data 'y) yi
(cffi:foreign-slot-value data 'ntuple-data 'z) zi))
(bookdata-ntuple ntuple))
(close-ntuple ntuple))))
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