Commit d6a6ffdf authored by liam's avatar liam
Browse files

Defined generic functions #'data and #'(setf data) to set all values

at once.  Methods for all subclasses.  Add print method for data.
Rename to #'defdata from gsl-data-functions.


git-svn-id: svn+ssh://pop/opt/space/mathematics/gsl/trunk@3033 a3d8a0fb-c1db-0310-ace7-a616afeb9e30
parent 77675db1
......@@ -3,7 +3,7 @@
; description: Blocks of data
; date: Mon Mar 27 2006 - 12:28
; author: Liam M. Healy
; modified: Thu Apr 13 2006 - 00:00
; modified: Fri Apr 14 2006 - 16:54
;********************************************************
;;; $Id: $
......@@ -14,5 +14,4 @@
(size :size)
(data :pointer))
(gsl-data-functions "block" :double)
(defdata "block" :double)
......@@ -3,14 +3,14 @@
; description: Combinations
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Wed Apr 12 2006 - 23:51
; modified: Fri Apr 14 2006 - 17:50
;********************************************************
;;; $Id: $
(in-package :gsl)
;;;;****************************************************************************
;;;; Combination object definition, allocation, reading & writing
;;;; Combination structure and CL object
;;;;****************************************************************************
;;; GSL-combination definition
......@@ -20,10 +20,34 @@
(data :pointer))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "combination" :size 2)
(defdata "combination" :size 'fixnum 2)
(add-wrap-type gsl-combination-c (lambda (x) `(pointer ,x)))
;;;;****************************************************************************
;;;; Getting values
;;;;****************************************************************************
(defun-gsl gsl-aref
(((pointer combination) :pointer) ((first indices) :size))
"gsl_combination_get"
:method ((combination gsl-combination) &rest indices)
:return (:size)
:c-return-value :return
:documentation "The ith element of the combination.")
(defmethod data ((object gsl-combination) &optional sequence)
(let ((seq (or sequence
(make-sequence 'list (combination-size object)))))
(loop for i from 0
below (min (length seq) (combination-size object))
do (setf (elt seq i) (gsl-aref object i)))
seq))
;;;;****************************************************************************
;;;; Setting values
;;;;****************************************************************************
(defun-gsl init-first ((combination gsl-combination-c))
"gsl_combination_init_first"
:c-return-value :void
......@@ -45,23 +69,6 @@
"Copy the elements of the combination @var{src} into the
combination @var{dest}. The two combinations must have the same size.")
;;;;****************************************************************************
;;;; Accessing combination elements
;;;;****************************************************************************
(defun-gsl gsl-aref
(((pointer combination) :pointer) ((first indices) :size))
"gsl_combination_get"
:method ((combination gsl-combination) &rest indices)
:return (:size)
:c-return-value :return
:documentation "The ith element of the combination.")
(defmethod data-export ((combination gsl-combination))
"The combination as a list."
(loop for j below (combination-size combination)
collect (gsl-aref combination j)))
;;;;****************************************************************************
;;;; Combination properties
;;;;****************************************************************************
......@@ -112,7 +119,7 @@
repeatedly applying this function will iterate through all possible
combinations of a given order.")
(defun-gsl combination-prev ((c gsl-combination-c))
(defun-gsl combination-previous ((c gsl-combination-c))
"gsl_combination_prev"
:c-return-value :success-failure
:documentation
......@@ -126,24 +133,10 @@
;;;;****************************************************************************
#|
;;; This is the example in the GSL manual, but we do not use
;;; the C streams for output, rather we use gsl-aref.
(loop for i from 0 to 4
do
(with-data (comb combination (4 i) t)
(loop do
(princ "{")
(loop for j below (combination-size comb) do
(princ (gsl-aref comb j)))
(princ "}")
while (combination-next comb))))
{}{0}{1}{2}{3}{01}{02}{03}{12}{13}{23}{012}{013}{023}{123}{0123}
(loop for i from 0 to 4
append
(with-data (comb combination (4 i) t)
(loop collect (combination-list comb)
(loop collect (data comb)
while (combination-next comb))))
(NIL (0) (1) (2) (3) (0 1) (0 2) (0 3) (1 2) (1 3) (2 3)
......
......@@ -3,7 +3,7 @@
; description: Using GSL storage.
; date: Sun Mar 26 2006 - 16:32
; author: Liam M. Healy
; modified: Thu Apr 13 2006 - 22:55
; modified: Fri Apr 14 2006 - 18:13
;********************************************************
;;; $Id: $
......@@ -17,6 +17,10 @@
((pointer :initarg :pointer :reader pointer)
(storage-size :initarg :storage-size :reader storage-size )))
(defmethod print-object ((object gsl-data) stream)
(print-unreadable-object (object stream :type t :identity t)
(princ (data object) stream)))
;;; Accessing elements
(export 'gsl-aref)
(defgeneric gsl-aref (object &rest indices)
......@@ -25,40 +29,6 @@
(defgeneric (setf gsl-aref) (value object &rest indices)
(:documentation "Set an element of the data."))
;;; Initializing elements
(export 'set-all)
(defgeneric set-all (object value)
(:documentation "Set all elements to the value."))
(export 'set-zero)
(defgeneric set-zero (object)
(:documentation "Set all elements to 0."))
(export 'set-identity)
(defgeneric set-identity (object)
(:documentation "Set elements to represent the identity."))
(export 'data-import)
(defgeneric data-import (object from)
(:documentation "Import the values from the CL object."))
(export 'data-export)
(defgeneric data-export (object)
(:documentation "Create a CL object with the values."))
(export 'data-validate)
(defgeneric data-valid (object)
(:documentation "Validate the values in the object."))
(defgeneric alloc (object)
(:documentation "Allocate GSL data; used internally."))
(defgeneric calloc (object)
(:documentation "Allocate GSL data and clear; used internally."))
(defgeneric free (object)
(:documentation "Free GSL data; used internally."))
(export '(write-binary read-binary write-formatted read-formatted))
(defgeneric write-binary (object stream)
(:documentation "Write the binary GSL data."))
......@@ -73,7 +43,7 @@
(:documentation "Read the formatted GSL data."))
;;;;****************************************************************************
;;;; Macro gsl-data-functions
;;;; Macro defdata to define class etc.
;;;;****************************************************************************
(defun data-object-name (string)
......@@ -88,7 +58,7 @@
(setf (slot-value object 'pointer)
pointer))
(defmacro gsl-data-functions (string base-type &optional (dimensions 1))
(defmacro defdata (string c-base-type cl-base-type &optional (dimensions 1))
"For the type named in the string,
define the allocator (gsl-*-alloc), zero allocator (gsl-*-calloc),
freeing (gsl-*-free), binary writing (binary-*-write) and
......@@ -102,8 +72,10 @@
(object-name (data-object-name string)))
`(progn
(defclass ,object-name (gsl-data)
((base-type :initform ,base-type :reader base-type
:allocation :class)))
((c-base-type :initform ,c-base-type :reader c-base-type
:allocation :class)
(cl-base-type :initform ,cl-base-type :reader cl-base-type
:allocation :class)))
(defmethod alloc ((object ,object-name))
(assign-pointer
object
......@@ -139,23 +111,99 @@
:method ((object ,object-name) stream format))))))
;;;;****************************************************************************
;;;; Macro with-data
;;;; Making data objects and initializing storage
;;;;****************************************************************************
(export 'with-data)
(export '(make-data with-data))
(defgeneric alloc (object)
(:documentation "Allocate GSL data; used internally."))
(defgeneric calloc (object)
(:documentation "Allocate GSL data and clear; used internally."))
(defgeneric free (object)
(:documentation "Free GSL data; used internally."))
(defun make-data (type zero &rest 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
(data-object-name type)
:storage-size 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 ((sz (if (listp size) size (list size))))
`(let ((,symbol
(make-instance
',(data-object-name type)
:storage-size ,(cons 'list sz))))
(,(if zero 'calloc 'alloc) ,symbol)
(unwind-protect
(progn ,@body)
(free ,symbol)))))
`(let ((,symbol
(make-data ',type ,zero ,@(if (listp size) size (list size)))))
(unwind-protect
(progn ,@body)
(free ,symbol))))
;;;;****************************************************************************
;;;; Getting values
;;;;****************************************************************************
(export 'data)
(defgeneric data (object &optional destination)
(:documentation "Extract the values in the object to a CL object.
The destination may be a sequence, 'vector, 'list.
If it is a sequence, that object is filled with the values.
If it is any other object, a new sequence is made of the type
specified.")
;; Default method is to make a sequence
(:method ((object gsl-data) &optional (sequence 'vector))
(let* ((total-size (apply #'* (storage-size object)))
(seq
(case sequence
(list (make-list total-size))
((nil vector)
(make-array (list total-size)
:element-type (cl-base-type object)))
(t sequence))))
(loop for i from 0
below (min (length seq) total-size)
do (setf (elt seq i) (gsl-aref object i)))
seq)))
;;;;****************************************************************************
;;;; Setting values
;;;;****************************************************************************
(defgeneric (setf data) (cl-array object)
(:documentation "Set the values in the object from a CL array.")
;; Default method is to read from a sequence
(:method
(sequence (object gsl-data))
(loop for i from 0
below (min (length sequence) (apply #'* (storage-size object)))
do (setf (gsl-aref object i) (elt sequence i)))))
(export 'set-all)
(defgeneric set-all (object value)
(:documentation "Set all elements to the value."))
(export 'set-zero)
(defgeneric set-zero (object)
(:documentation "Set all elements to 0."))
(export 'set-identity)
(defgeneric set-identity (object)
(:documentation "Set elements to represent the identity."))
(export 'data-valid)
(defgeneric data-valid (object)
(:documentation "Validate the values in the object."))
;;;;****************************************************************************
;;;; To be deleted
;;;;****************************************************************************
#+new-broken
(defmacro with-data ((symbol type size &optional init validate) &body body)
......@@ -200,11 +248,6 @@
(case init
(:identity `((set-identity ,symbol)))))
#+new
(defun free-data (data)
)
;;;(with-data (p permutation 5 #(2 3 4 0) t) foo)
#|
......
......@@ -3,7 +3,7 @@
; description: Matrices
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Wed Apr 12 2006 - 23:51
; modified: Fri Apr 14 2006 - 17:49
;********************************************************
;;; $Id: $
......@@ -23,12 +23,12 @@
(owner :int))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "matrix" :double 2)
(defdata "matrix" :double 'double-float 2)
(add-wrap-type gsl-matrix-c (lambda (x) `(pointer ,x)))
;;;;****************************************************************************
;;;; Accessing elements
;;;; Getting values
;;;;****************************************************************************
(defun-gsl gsl-aref
......@@ -41,6 +41,30 @@
:c-return-value :return
:documentation "The (i,j)-th element of the matrix.")
(defun-gsl gsl-matrix-ptr ((matrix :pointer) (i :size) (j :size))
"gsl_matrix_ptr"
:return (:pointer)
:c-return-value :return
:documentation "A pointer to the @math{(i,j)}-th element of a
matrix @var{m}.")
(defmethod data ((object gsl-matrix) &optional array)
(let ((arr (or array
(make-array (storage-size object)
:element-type 'double-float))))
(loop for i from 0
below (min (array-dimension arr 0) (first (storage-size object)))
do
(loop for j from 0
below (min (array-dimension arr 1) (second (storage-size object)))
do
(setf (aref arr i j) (gsl-aref object i j))))
arr))
;;;;****************************************************************************
;;;; Setting values
;;;;****************************************************************************
(defun-gsl (setf gsl-aref)
(((pointer matrix) :pointer)
((first indices) :size)
......@@ -51,16 +75,16 @@
:c-return-value :void
:documentation "Set the (i,j)-th element of the matrix.")
(defun-gsl gsl-matrix-ptr ((matrix :pointer) (i :size) (j :size))
"gsl_matrix_ptr"
:return (:pointer)
:c-return-value :return
:documentation "A pointer to the @math{(i,j)}-th element of a
matrix @var{m}.")
;;;;****************************************************************************
;;;; Initializing elements
;;;;****************************************************************************
(defmethod (setf data) (array (object gsl-matrix))
(loop for i from 0
below
(min (array-dimension array 0) (first (storage-size object)))
do
(loop for j from 0
below
(min (array-dimension array 1) (second (storage-size object)))
do
(setf (gsl-aref object i j) (aref array i j)))))
(defun-gsl set-all (((pointer object) :pointer) (value :double))
"gsl_matrix_set_all"
......@@ -405,4 +429,35 @@ columns, and the physical number of columns in memory is given by
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))
#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)
(400.23d0 401.23d0 402.23d0)
(500.23d0 501.23d0 502.23d0)
(600.23d0 601.23d0 602.23d0)
(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))
|#
......@@ -3,14 +3,14 @@
; description: Permutations
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Wed Apr 12 2006 - 23:51
; modified: Fri Apr 14 2006 - 18:00
;********************************************************
;;; $Id: $
(in-package :gsl)
;;;;****************************************************************************
;;;; Permutation object definition, allocation, reading & writing
;;;; Permutation structure and CL object
;;;;****************************************************************************
;;; GSL-permutation definition
......@@ -19,11 +19,27 @@
(data :pointer))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "permutation" :size)
(defdata "permutation" :size 'fixnum)
(add-wrap-type gsl-permutation-c (lambda (x) `(pointer ,x)))
(defun-gsl set-identity (((pointer permutation) gsl-permutation-c))
;;;;****************************************************************************
;;;; Getting values
;;;;****************************************************************************
(defun-gsl gsl-aref
(((pointer permutation) :pointer) ((first indices) :size))
"gsl_permutation_get"
:method ((permutation gsl-permutation) &rest indices)
:return (:size)
:c-return-value :return
:documentation "The ith element of the permutation.")
;;;;****************************************************************************
;;;; Setting values
;;;;****************************************************************************
(defun-gsl set-identity (((pointer permutation) :pointer))
"gsl_permutation_init"
:method ((permutation gsl-permutation))
:documentation
......@@ -35,19 +51,7 @@
"gsl_permutation_memcpy"
:documentation
"Copy the elements of the permutation @var{src} into the
permutation @var{dest}. The two permutations must have the same size.")
;;;;****************************************************************************
;;;; Accessing elements
;;;;****************************************************************************
(defun-gsl gsl-aref
(((pointer permutation) :pointer) ((first indices) :size))
"gsl_permutation_get"
:method ((permutation gsl-permutation) &rest indices)
:return (:double)
:c-return-value :return
:documentation "The ith element of the permutation.")
permutation @var{dest}. The two permutations must have the same size.")
(defun-gsl permutation-swap ((p gsl-permutation-c) (i :size) (j :size))
"gsl_permutation_swap"
......@@ -213,5 +217,12 @@ once.")
;;;;****************************************************************************
#|
(with-data (perm permutation 4 t)
(loop collect (data perm 'list)
while (permutation-next perm)))
((0 1 2 3) (0 1 3 2) (0 2 1 3) (0 2 3 1) (0 3 1 2) (0 3 2 1) (1 0 2 3)
(1 0 3 2) (1 2 0 3) (1 2 3 0) (1 3 0 2) (1 3 2 0) (2 0 1 3) (2 0 3 1)
(2 1 0 3) (2 1 3 0) (2 3 0 1) (2 3 1 0) (3 0 1 2) (3 0 2 1) (3 1 0 2)
(3 1 2 0) (3 2 0 1) (3 2 1 0))
|#
......@@ -3,7 +3,7 @@
; description: Vectors
; date: Sun Mar 26 2006 - 11:51
; author: Liam M. Healy
; modified: Wed Apr 12 2006 - 23:51
; modified: Fri Apr 14 2006 - 17:49
;********************************************************
;;; $Id: $
......@@ -22,7 +22,7 @@
;;; (with-data ((vec1 vector 3) (vec2 vector 3)) ...)
;;;;****************************************************************************
;;;; Vector object definition, allocation, reading & writing
;;;; Vector structure and CL object
;;;;****************************************************************************
#|
......@@ -48,12 +48,12 @@ deallocated with the vector.
(owner :int))
;;; Allocation, freeing, reading and writing
(gsl-data-functions "vector" :double)
(defdata "vector" :double 'double-float)
(add-wrap-type gsl-vector-c (lambda (x) `(pointer ,x)))
;;;;****************************************************************************
;;;; Accessing elements
;;;; Getting values
;;;;****************************************************************************
(defun-gsl gsl-aref
......@@ -64,13 +64,6 @@ deallocated with the vector.
:c-return-value :return
:documentation "The ith element of the vector.")
(defun-gsl (setf gsl-aref)
(((pointer vector) :pointer) ((first indices) :size) (value :double))
"gsl_vector_set"
:method (value (vector gsl-vector) &rest indices)
:c-return-value :void
:documentation "Set the ith element of the vector.")
(defun-gsl gsl-vector-ptr ((vector :pointer) (i :size))
"gsl_vector_ptr"
:return (:pointer)
......@@ -78,9 +71,16 @@ deallocated with the vector.
:documentation "The ith element of the vector as a pointer.")
;;;;****************************************************************************
;;;; Initializing elements
;;;; Setting values
;;;;****************************************************************************
(defun-gsl (setf gsl-aref)
(((pointer vector) :pointer) ((first indices) :size) (value :double))
"gsl_vector_set"
:method (value (vector gsl-vector) &rest indices)
:c-return-value :void
:documentation "Set the ith element of the vector.")
(defun-gsl set-all (((pointer object) :pointer) (value :double))
"gsl_vector_set_all"
:method ((object gsl-vector) value)
......@@ -319,6 +319,14 @@ vector @var{a}, @math{a'_i = a_i + x}.")
(gsl-aref vec 2) 12.8d0)
(print-vector vec))
(with-data (vec vector 3)
(setf (data vec) #(-3.21d0 1.0d0 12.8d0))
(print-vector vec))
(with-data (vec vector 3)
(setf (data vec) #(-3.21d0 1.0d0 12.8d0))
(data vec))
(with-data (vec vector 3)
(set-all vec 77.8d0)
(print-vector vec)
......
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