Skip to content
Snippets Groups Projects
Commit 7c66d57b authored by Liam Healy's avatar Liam Healy
Browse files

New class foreign-array, new names: marray, make-marray, mobject.lisp

New class foreign-array represents foreign (C) arrays, without GSL or
mobject superclass.  New class name 'marray was 'gsl-data,
representing arrays in GSL.  These objects are made by #'make-marray,
formerely #'make-array*.  New file names: init/mobject.lisp was
init/gsl-objects.lisp and data/marray.lisp was data/data.lisp.
parent a9dda7c4
No related branches found
No related tags found
No related merge requests found
Showing
with 86 additions and 84 deletions
;; Basis splines. ;; Basis splines.
;; Liam Healy 2008-02-18 14:43:20EST basis-splines.lisp ;; Liam Healy 2008-02-18 14:43:20EST basis-splines.lisp
;; Time-stamp: <2008-12-21 21:46:10EST basis-splines.lisp> ;; Time-stamp: <2008-12-26 10:25:46EST basis-splines.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -112,13 +112,13 @@ ...@@ -112,13 +112,13 @@
(bw (make-basis-spline order nbreak)) (bw (make-basis-spline order nbreak))
(mw (fit-workspace ndata ncoeffs)) (mw (fit-workspace ndata ncoeffs))
(rng (random-number-generator *mt19937* 0)) (rng (random-number-generator *mt19937* 0))
(B (make-array* 'double-float :dimensions ncoeffs)) (B (make-marray 'double-float :dimensions ncoeffs))
(c (make-array* 'double-float :dimensions ncoeffs)) (c (make-marray 'double-float :dimensions ncoeffs))
(cov (make-array* 'double-float :dimensions (list ncoeffs ncoeffs))) (cov (make-marray 'double-float :dimensions (list ncoeffs ncoeffs)))
(w (make-array* 'double-float :dimensions ndata)) (w (make-marray 'double-float :dimensions ndata))
(x (make-array* 'double-float :dimensions ndata)) (x (make-marray 'double-float :dimensions ndata))
(y (make-array* 'double-float :dimensions ndata)) (y (make-marray 'double-float :dimensions ndata))
(Xmatrix (make-array* 'double-float :dimensions (list ndata ncoeffs))) (Xmatrix (make-marray 'double-float :dimensions (list ndata ncoeffs)))
(sigma 0.1d0)) (sigma 0.1d0))
;; The data to be fitted. ;; The data to be fitted.
(dotimes (i ndata) (dotimes (i ndata)
......
;; Use the foreign-friendly arrays package. ;; Use the foreign-friendly arrays package.
;; Liam Healy 2008-03-22 15:40:08EDT ;; Liam Healy 2008-03-22 15:40:08EDT
;; Time-stamp: <2008-11-30 18:44:50EST foreign-friendly.lisp> ;; Time-stamp: <2008-12-26 10:10:40EST foreign-friendly.lisp>
;; $Id$ ;; $Id$
;;; Foreign-friendly arrays (original implementation by Tamas Papp) ;;; Foreign-friendly arrays (original implementation by Tamas Papp)
...@@ -116,10 +116,10 @@ ...@@ -116,10 +116,10 @@
,body)) ,body))
#+sbcl #+sbcl
(defun c-pointer (gsl-data) (defun c-pointer (marray)
"The pointer to the C array." "The pointer to the C array."
(cffi:inc-pointer (cffi:inc-pointer
(sb-sys:vector-sap (original-array gsl-data)) (offset gsl-data))) (sb-sys:vector-sap (original-array marray)) (offset marray)))
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; Pointer management ;;;; Pointer management
......
;; Get/set array or elements: cl-array, maref ;; Get/set array or elements: cl-array, maref
;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp ;; Liam Healy 2008-08-27 22:43:10EDT maref.lisp
;; Time-stamp: <2008-12-07 17:08:25EST maref.lisp> ;; Time-stamp: <2008-12-26 10:25:50EST maref.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :gsl)
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
;;; Both these functions take one of the following class arguments for ;;; Both these functions take one of the following class arguments for
;;; the array: ;;; the array:
;;; - a gsl-data ;;; - a marray
;;; - a Common Lisp array ;;; - a Common Lisp array
;;; - a pointer to a GSL vector or matrix structure ;;; - a pointer to a GSL vector or matrix structure
...@@ -28,11 +28,11 @@ ...@@ -28,11 +28,11 @@
(defgeneric cl-array (object &optional array-rank element-type) (defgeneric cl-array (object &optional array-rank element-type)
(:documentation (:documentation
"The array as a CL native array. The object may be a gsl-data object, "The array as a CL native array. The object may be a marray object,
a pointer to a GSL vector or matrix, or an ordinary CL array of one a pointer to a GSL vector or matrix, or an ordinary CL array of one
or two dimensions. Optional arguments array-rank and element-type or two dimensions. Optional arguments array-rank and element-type
are used only for pointers.") are used only for pointers.")
(:method ((object gsl-data) &optional array-rank element-type) (:method ((object marray) &optional array-rank element-type)
(declare (ignore array-rank element-type)) (declare (ignore array-rank element-type))
#-native (copy-c-to-cl object) #-native (copy-c-to-cl object)
(slot-value object 'cl-array)) (slot-value object 'cl-array))
...@@ -53,7 +53,7 @@ ...@@ -53,7 +53,7 @@
;; Matrix ;; Matrix
(let* ((dim1 (cffi:foreign-slot-value pointer 'gsl-matrix-c 'size1)) (let* ((dim1 (cffi:foreign-slot-value pointer 'gsl-matrix-c 'size1))
(dim2 (cffi:foreign-slot-value pointer 'gsl-matrix-c 'size2)) (dim2 (cffi:foreign-slot-value pointer 'gsl-matrix-c 'size2))
(array (make-array* (list dim1 dim2) element-type))) (array (make-marray (list dim1 dim2) element-type)))
;; Copy over from the C side ;; Copy over from the C side
(loop for i below dim1 (loop for i below dim1
do (loop for j below dim2 do do (loop for j below dim2 do
...@@ -61,7 +61,7 @@ ...@@ -61,7 +61,7 @@
array) array)
;; Vector ;; Vector
(let* ((size (cffi:foreign-slot-value pointer 'gsl-vector-c 'size)) (let* ((size (cffi:foreign-slot-value pointer 'gsl-vector-c 'size))
(array (make-array* size element-type))) (array (make-marray size element-type)))
;; Copy over from the C side ;; Copy over from the C side
(loop for i below size (loop for i below size
do (setf (aref array i) (maref pointer i))) do (setf (aref array i) (maref pointer i)))
...@@ -73,9 +73,9 @@ ...@@ -73,9 +73,9 @@
(defgeneric maref (object index &optional index2 type) (defgeneric maref (object index &optional index2 type)
(:documentation (:documentation
"An element of the data. The object may be a gsl-data object, a pointer to "An element of the data. The object may be a marray object, a pointer to
a GSL vector or matrix, or an ordinary CL array of one or two dimensions.") a GSL vector or matrix, or an ordinary CL array of one or two dimensions.")
(:method ((object gsl-data) index &optional index2 type) (:method ((object marray) index &optional index2 type)
(declare (ignore type)) (declare (ignore type))
#-native (copy-c-to-cl object) #-native (copy-c-to-cl object)
(if index2 (if index2
...@@ -93,10 +93,10 @@ ...@@ -93,10 +93,10 @@
(defgeneric (setf maref) (value object index &optional index2 type) (defgeneric (setf maref) (value object index &optional index2 type)
(:documentation (:documentation
"Set an element of the data. The object may be a gsl-data object, "Set an element of the data. The object may be a marray object,
a pointer to a GSL vector or matrix, or an ordinary CL array a pointer to a GSL vector or matrix, or an ordinary CL array
of one or two dimensions.") of one or two dimensions.")
(:method (value (object gsl-data) index &optional index2 type) (:method (value (object marray) index &optional index2 type)
(declare (ignore type)) (declare (ignore type))
(if index2 (if index2
(setf (aref (slot-value object 'cl-array) index index2) value) (setf (aref (slot-value object 'cl-array) index index2) value)
......
;; "Data" is bulk arrayed data, like vectors, matrices, permutations, ;; A "marray" is an array in both GSL and CL
;; combinations, or histograms.
;; Liam Healy 2008-04-06 21:23:41EDT ;; Liam Healy 2008-04-06 21:23:41EDT
;; Time-stamp: <2008-12-25 09:40:55EST data.lisp> ;; Time-stamp: <2008-12-26 10:25:50EST marray.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
;;;;**************************************************************************** ;;;;****************************************************************************
;;;; The class gsl-data and element types that make subclasses ;;;; The class marray and element types that make subclasses
;;;;**************************************************************************** ;;;;****************************************************************************
(defclass gsl-data (mobject) (defclass foreign-array ()
((cl-array :documentation "The Lisp array.") ((cl-array :documentation "The Lisp array.")
(block-pointer :initform nil :accessor block-pointer
:documentation "A pointer to the gsl-block-c.")
#-native #-native
(c-pointer :accessor c-pointer :documentation "A pointer to the C array.") (c-pointer :accessor c-pointer :documentation "A pointer to the C array.")
(dimensions :reader dimensions) (dimensions :reader dimensions)
...@@ -39,14 +36,19 @@ ...@@ -39,14 +36,19 @@
way. If a list of index sets, those indices disagree and the remainder way. If a list of index sets, those indices disagree and the remainder
are correct.")) are correct."))
(:documentation (:documentation
"A superclass for all data storage structures, such as vector, matrix, "A superclass for arrays represented in C and CL."))
etc."))
(defclass marray (mobject foreign-array)
((block-pointer :initform nil :accessor block-pointer
:documentation "A pointer to the gsl-block-c."))
(:documentation
"A superclass for arrays represented in GSL and CL."))
(export '(dimensions total-size element-type)) (export '(dimensions total-size element-type))
;;; Allowable keys: :dimensions, :initial-contents, :initial-element. ;;; Allowable keys: :dimensions, :initial-contents, :initial-element.
(defmethod initialize-instance :after (defmethod initialize-instance :after
((object gsl-data) &rest initargs &key &allow-other-keys) ((object marray) &rest initargs &key &allow-other-keys)
(with-slots (cl-array dimensions original-array offset total-size) object (with-slots (cl-array dimensions original-array offset total-size) object
(let ((ffa (apply #'make-ffa (element-type object) initargs))) (let ((ffa (apply #'make-ffa (element-type object) initargs)))
(setf cl-array ffa (setf cl-array ffa
...@@ -61,14 +63,14 @@ ...@@ -61,14 +63,14 @@
(cffi:foreign-type-size (cl-cffi (element-type object))))))) (cffi:foreign-type-size (cl-cffi (element-type object)))))))
(alloc-gsl-struct object)) (alloc-gsl-struct object))
(defmethod print-object ((object gsl-data) stream) (defmethod print-object ((object marray) stream)
(print-unreadable-object (object stream :type t) (print-unreadable-object (object stream :type t)
#-native (copy-c-to-cl object) #-native (copy-c-to-cl object)
(princ (cl-array object) stream))) (princ (cl-array object) stream)))
(defmethod make-load-form ((object gsl-data) &optional env) (defmethod make-load-form ((object marray) &optional env)
(declare (ignore env)) (declare (ignore env))
`(make-array* `(make-marray
',(element-type object) ',(element-type object)
:initial-contents :initial-contents
',(loop for elt across ',(loop for elt across
...@@ -125,8 +127,8 @@ ...@@ -125,8 +127,8 @@
;;;; Make data from either the dimensions provided or from the initial values ;;;; Make data from either the dimensions provided or from the initial values
;;;;**************************************************************************** ;;;;****************************************************************************
(export 'make-array*) (export 'make-marray)
(defun make-array* (defun make-marray
(element-type &rest keys &key dimensions initial-contents &allow-other-keys) (element-type &rest keys &key dimensions initial-contents &allow-other-keys)
"Make a GSLL array with the given element type, "Make a GSLL array with the given element type,
:dimensions, :initial-contents and/or :initial-element." :dimensions, :initial-contents and/or :initial-element."
...@@ -162,7 +164,7 @@ ...@@ -162,7 +164,7 @@
(declare (ignore subchar)) (declare (ignore subchar))
(read-char stream) (read-char stream)
(let ((list (read-delimited-list #\) stream))) (let ((list (read-delimited-list #\) stream)))
`(make-array* ',(hashm-numeric-code arg) :initial-contents ',list)))) `(make-marray ',(hashm-numeric-code arg) :initial-contents ',list))))
(defun component-type (eltype) (defun component-type (eltype)
(cl-cffi (component-float-type eltype))) (cl-cffi (component-float-type eltype)))
...@@ -264,7 +266,7 @@ ...@@ -264,7 +266,7 @@
(defgeneric alloc-gsl-struct (object) (defgeneric alloc-gsl-struct (object)
(:documentation "Allocate the GSL structure.") (:documentation "Allocate the GSL structure.")
(:method ((object gsl-data)) (:method ((object marray))
;; Need to check that all allocations succeeded. ;; Need to check that all allocations succeeded.
(unless (block-pointer object) (unless (block-pointer object)
(let ((blockptr (cffi:foreign-alloc 'gsl-block-c))) (let ((blockptr (cffi:foreign-alloc 'gsl-block-c)))
......
;; Matrices ;; Matrices
;; Liam Healy 2008-04-15 21:57:52EDT matrix.lisp ;; Liam Healy 2008-04-15 21:57:52EDT matrix.lisp
;; Time-stamp: <2008-11-15 13:35:20EST matrix.lisp> ;; Time-stamp: <2008-12-26 10:10:38EST matrix.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -18,7 +18,7 @@ ...@@ -18,7 +18,7 @@
(block :pointer) (block :pointer)
(owner :int)) (owner :int))
(defclass matrix (gsl-data) (defclass matrix (marray)
() ()
(:documentation "GSL matrices.")) (:documentation "GSL matrices."))
......
;; Vectors ;; Vectors
;; Liam Healy 2008-04-13 09:39:02EDT vector.lisp ;; Liam Healy 2008-04-13 09:39:02EDT vector.lisp
;; Time-stamp: <2008-11-29 14:19:54EST vector.lisp> ;; Time-stamp: <2008-12-26 10:10:39EST vector.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -17,7 +17,7 @@ ...@@ -17,7 +17,7 @@
(block :pointer) (block :pointer)
(owner :int)) (owner :int))
(defclass mvector (gsl-data) (defclass mvector (marray)
() ()
(:documentation "GSL vectors.")) (:documentation "GSL vectors."))
......
;; Eigenvectors and eigenvalues ;; Eigenvectors and eigenvalues
;; Liam Healy, Sun May 21 2006 - 19:52 ;; Liam Healy, Sun May 21 2006 - 19:52
;; Time-stamp: <2008-12-25 11:28:44EST eigensystems.lisp> ;; Time-stamp: <2008-12-26 10:28:19EST eigensystems.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -194,8 +194,8 @@ ...@@ -194,8 +194,8 @@
;;;;**************************************************************************** ;;;;****************************************************************************
(defun eigenvalue-eigenvectors-example () (defun eigenvalue-eigenvectors-example ()
(letm ((evecs (make-array* 'double-float :dimensions '(3 3))) (letm ((evecs (make-marray 'double-float :dimensions '(3 3)))
(evals (make-array* 'double-float :dimensions 3)) (evals (make-marray 'double-float :dimensions 3))
(ws (eigen-symmv 3)) (ws (eigen-symmv 3))
(mat #m((20.0d0 -10.0d0 0.0d0) (mat #m((20.0d0 -10.0d0 0.0d0)
(-10.0d0 30.0d0 0.0d0) (-10.0d0 30.0d0 0.0d0)
......
;; Definition of GSLL system ;; Definition of GSLL system
;; Liam Healy ;; Liam Healy
;; Time-stamp: <2008-11-30 23:17:52EST gsll.asd> ;; Time-stamp: <2008-12-26 10:54:32EST gsll.asd>
;; $Id$ ;; $Id$
(asdf:defsystem "gsll" (asdf:defsystem "gsll"
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
:components :components
((:file "init") ((:file "init")
(:file "conditions" :depends-on (init)) (:file "conditions" :depends-on (init))
(:file "gsl-objects" :depends-on (init)) (:file "mobject" :depends-on (init))
(:file "element-types" :depends-on (init)) (:file "element-types" :depends-on (init))
(:file "number-conversion" :depends-on (init)) (:file "number-conversion" :depends-on (init))
(:file "interface" (:file "interface"
...@@ -33,15 +33,15 @@ ...@@ -33,15 +33,15 @@
:depends-on (init) :depends-on (init)
:components :components
((:file "foreign-friendly") ((:file "foreign-friendly")
(:file "data" :depends-on (foreign-friendly)) (:file "marray" :depends-on (foreign-friendly))
(:file "vector" :depends-on (data)) (:file "vector" :depends-on (marray))
(:file "matrix" :depends-on (data vector)) (:file "matrix" :depends-on (marray vector))
(:file "maref" :depends-on (data vector matrix)) (:file "maref" :depends-on (marray vector matrix))
(:file "both" :depends-on (data vector matrix)) (:file "both" :depends-on (marray vector matrix))
(:file "array-tests" :depends-on (both)) (:file "array-tests" :depends-on (both))
(:file "permutation" :depends-on (data)) (:file "permutation" :depends-on (marray))
(:file "combination" ; preload defgeneric (:file "combination" ; preload defgeneric
:depends-on (data matrix both permutation)))) :depends-on (marray matrix both permutation))))
(:file "polynomial" :depends-on (init data)) (:file "polynomial" :depends-on (init data))
(:module special-functions (:module special-functions
:depends-on (init) :depends-on (init)
......
;; Define examples. ;; Define examples.
;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
;; Time-stamp: <2008-11-30 23:02:06EST generate-examples.lisp> ;; Time-stamp: <2008-12-26 10:25:47EST generate-examples.lisp>
;; $Id: $ ;; $Id: $
;;; Define examples that can be displayed by users with the function ;;; Define examples that can be displayed by users with the function
...@@ -78,7 +78,7 @@ ...@@ -78,7 +78,7 @@
(defun make-vector-from-pool (type length &optional (starting 0)) (defun make-vector-from-pool (type length &optional (starting 0))
"Make a vector of the specified element type and length using the "Make a vector of the specified element type and length using the
pool data for the type and starting at the specified point in the pool." pool data for the type and starting at the specified point in the pool."
(make-array* (make-marray
length type length type
:initial-contents :initial-contents
(make-list-from-pool type length starting))) (make-list-from-pool type length starting)))
...@@ -108,9 +108,9 @@ ...@@ -108,9 +108,9 @@
(let ((matrixp (listp spec))) (let ((matrixp (listp spec)))
(if no-init (if no-init
;; No initial values, just dimension ;; No initial values, just dimension
`(make-array* ',default-element-type :dimensions ',spec) `(make-marray ',default-element-type :dimensions ',spec)
;; Initial contents ;; Initial contents
`(make-array* `(make-marray
',default-element-type ',default-element-type
:initial-contents :initial-contents
',(if matrixp ',(if matrixp
......
File moved
;; Example spline ;; Example spline
;; Liam Healy, Sat Nov 10 2007 - 21:18 ;; Liam Healy, Sat Nov 10 2007 - 21:18
;; Time-stamp: <2008-11-30 23:45:40EST spline-example.lisp> ;; Time-stamp: <2008-12-26 10:29:01EST spline-example.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -20,8 +20,8 @@ ...@@ -20,8 +20,8 @@
(multiple-value-bind (xarr yarr) (multiple-value-bind (xarr yarr)
(spline-example-arrays) (spline-example-arrays)
(letm ((acc (acceleration)) (letm ((acc (acceleration))
(cxarr (make-array* 'double-float :dimensions xarr)) (cxarr (make-marray 'double-float :dimensions xarr))
(cyarr (make-array* 'double-float :dimensions yarr)) (cyarr (make-marray 'double-float :dimensions yarr))
(spline (spline *cubic-spline-interpolation* cxarr cyarr))) (spline (spline *cubic-spline-interpolation* cxarr cyarr)))
(loop for xi from (aref xarr 0) below (aref xarr 9) by 0.01d0 (loop for xi from (aref xarr 0) below (aref xarr 9) by 0.01d0
collect (list xi (evaluate-spline spline xi acc)))))) collect (list xi (evaluate-spline spline xi acc))))))
;; Exponential of a matrix ;; Exponential of a matrix
;; Liam Healy 2008-08-10 17:25:35EDT exponential.lisp ;; Liam Healy 2008-08-10 17:25:35EDT exponential.lisp
;; Time-stamp: <2008-12-07 18:31:37EST exponential.lisp> ;; Time-stamp: <2008-12-26 10:25:48EST exponential.lisp>
;; $Id: $ ;; $Id: $
(in-package :gsl) (in-package :gsl)
...@@ -25,7 +25,7 @@ ...@@ -25,7 +25,7 @@
;;; A matrix of the form [[0, 1], [-1, 0]] ;;; A matrix of the form [[0, 1], [-1, 0]]
;;; when exponentiated gives [[cos x, sin x], [-sin x, cos x]] ;;; when exponentiated gives [[cos x, sin x], [-sin x, cos x]]
(letm ((mat #m((0.0d0 1.0d0) (-1.0d0 0.0d0))) (letm ((mat #m((0.0d0 1.0d0) (-1.0d0 0.0d0)))
(exp (make-array* 'double-float :dimensions '(2 2)))) (exp (make-marray 'double-float :dimensions '(2 2))))
(cl-array (matrix-exponential mat exp))) (cl-array (matrix-exponential mat exp)))
#2A((0.5403023058681384d0 0.841470984807895d0) #2A((0.5403023058681384d0 0.841470984807895d0)
(-0.841470984807895d0 0.5403023058681384d0)) (-0.841470984807895d0 0.5403023058681384d0))
......
;; LU decomposition ;; LU decomposition
;; Liam Healy, Thu Apr 27 2006 - 12:42 ;; Liam Healy, Thu Apr 27 2006 - 12:42
;; Time-stamp: <2008-12-07 18:32:04EST lu.lisp> ;; Time-stamp: <2008-12-26 10:25:47EST lu.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -136,11 +136,11 @@ ...@@ -136,11 +136,11 @@
(letm ((mmat mat) (letm ((mmat mat)
(dim (array-dimension mat 0)) (dim (array-dimension mat 0))
(per (make-permutation dim)) (per (make-permutation dim))
(inv (make-array* 'double-float :dimensions (list dim dim)))) (inv (make-marray 'double-float :dimensions (list dim dim))))
(LU-decomposition mmat per) (LU-decomposition mmat per)
(lu-invert mmat per inv) (lu-invert mmat per inv)
(cl-array inv))) (cl-array inv)))
(save-test lu (save-test lu
(invert-matrix (invert-matrix
(make-array* '(2 2) 'double-float :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0)))) (make-marray '(2 2) 'double-float :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0))))
;; Monte Carlo Integration ;; Monte Carlo Integration
;; Liam Healy Sat Feb 3 2007 - 17:42 ;; Liam Healy Sat Feb 3 2007 - 17:42
;; Time-stamp: <2008-12-25 11:42:39EST monte-carlo.lisp> ;; Time-stamp: <2008-12-26 10:28:19EST monte-carlo.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -329,21 +329,21 @@ ...@@ -329,21 +329,21 @@
(defun random-walk-plain-example (&optional (nsamples 500000)) (defun random-walk-plain-example (&optional (nsamples 500000))
(letm ((ws (monte-carlo-plain 3)) (letm ((ws (monte-carlo-plain 3))
(lower #m(0.0d0 0.0d0 0.0d0)) (lower #m(0.0d0 0.0d0 0.0d0))
(upper (make-array* 'double-float :initial-contents (list pi pi pi))) (upper (make-marray 'double-float :initial-contents (list pi pi pi)))
(rng (random-number-generator *mt19937* 0))) (rng (random-number-generator *mt19937* 0)))
(monte-carlo-integrate-plain monte-carlo-g lower upper nsamples rng ws))) (monte-carlo-integrate-plain monte-carlo-g lower upper nsamples rng ws)))
(defun random-walk-miser-example (&optional (nsamples 500000)) (defun random-walk-miser-example (&optional (nsamples 500000))
(letm ((ws (monte-carlo-miser 3)) (letm ((ws (monte-carlo-miser 3))
(lower #m(0.0d0 0.0d0 0.0d0)) (lower #m(0.0d0 0.0d0 0.0d0))
(upper (make-array* 'double-float :initial-contents (list pi pi pi))) (upper (make-marray 'double-float :initial-contents (list pi pi pi)))
(rng (random-number-generator *mt19937* 0))) (rng (random-number-generator *mt19937* 0)))
(monte-carlo-integrate-miser monte-carlo-g lower upper nsamples rng ws))) (monte-carlo-integrate-miser monte-carlo-g lower upper nsamples rng ws)))
(defun random-walk-vegas-example (&optional (nsamples 500000)) (defun random-walk-vegas-example (&optional (nsamples 500000))
(letm ((ws (monte-carlo-vegas 3)) (letm ((ws (monte-carlo-vegas 3))
(lower #m(0.0d0 0.0d0 0.0d0)) (lower #m(0.0d0 0.0d0 0.0d0))
(upper (make-array* 'double-float :initial-contents (list pi pi pi))) (upper (make-marray 'double-float :initial-contents (list pi pi pi)))
(rng (random-number-generator *mt19937* 0))) (rng (random-number-generator *mt19937* 0)))
(monte-carlo-integrate-vegas monte-carlo-g lower upper nsamples rng ws))) (monte-carlo-integrate-vegas monte-carlo-g lower upper nsamples rng ws)))
......
;; Polynomials ;; Polynomials
;; Liam Healy, Tue Mar 21 2006 - 18:33 ;; Liam Healy, Tue Mar 21 2006 - 18:33
;; Time-stamp: <2008-12-25 10:01:23EST polynomial.lisp> ;; Time-stamp: <2008-12-26 10:28:20EST polynomial.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -155,7 +155,7 @@ ...@@ -155,7 +155,7 @@
real and imaginary parts." real and imaginary parts."
(let ((len (total-size coefficients))) (let ((len (total-size coefficients)))
;; Should this be making a complex array? ;; Should this be making a complex array?
(letm ((answer (make-array* 'double-float :dimensions (* 2 (1- len)))) (letm ((answer (make-marray 'double-float :dimensions (* 2 (1- len))))
(ws (complex-workspace len))) (ws (complex-workspace len)))
(values-list (polynomial-solve-ws coefficients ws answer))))) (values-list (polynomial-solve-ws coefficients ws answer)))))
...@@ -181,7 +181,7 @@ ...@@ -181,7 +181,7 @@
(save-test polynomial (save-test polynomial
(let ((xa #m(0.0d0 1.0d0 2.0d0 3.0d0)) (let ((xa #m(0.0d0 1.0d0 2.0d0 3.0d0))
(ya #m(2.5d0 7.2d0 32.7d0 91.0d0)) (ya #m(2.5d0 7.2d0 32.7d0 91.0d0))
(dd (make-array* 'double-float :dimensions 4))) (dd (make-marray 'double-float :dimensions 4)))
(divided-difference dd xa ya) (divided-difference dd xa ya)
(list (list
(polynomial-eval-divided-difference dd xa 0.0d0) (polynomial-eval-divided-difference dd xa 0.0d0)
......
;; Dirichlet distribution ;; Dirichlet distribution
;; Liam Healy, Sun Oct 29 2006 ;; Liam Healy, Sun Oct 29 2006
;; Time-stamp: <2008-11-30 23:17:06EST dirichlet.lisp> ;; Time-stamp: <2008-12-26 10:28:21EST dirichlet.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -58,7 +58,7 @@ ...@@ -58,7 +58,7 @@
(save-test dirichlet (save-test dirichlet
(letm ((rng (random-number-generator *mt19937* 0)) (letm ((rng (random-number-generator *mt19937* 0))
(alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) (alpha #m(1.0d0 2.0d0 3.0d0 4.0d0))
(theta (make-array* 'double-float :dimensions 4))) (theta (make-marray 'double-float :dimensions 4)))
(dirichlet rng alpha theta) (dirichlet rng alpha theta)
(cl-array theta)) (cl-array theta))
(letm ((alpha #m(1.0d0 2.0d0 3.0d0 4.0d0)) (letm ((alpha #m(1.0d0 2.0d0 3.0d0 4.0d0))
......
;; Multinomial distribution ;; Multinomial distribution
;; Liam Healy, Sat Nov 25 2006 - 16:00 ;; Liam Healy, Sat Nov 25 2006 - 16:00
;; Time-stamp: <2008-11-30 23:19:48EST multinomial.lisp> ;; Time-stamp: <2008-12-26 10:28:20EST multinomial.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -51,7 +51,7 @@ ...@@ -51,7 +51,7 @@
(save-test multinomial (save-test multinomial
(letm ((rng (random-number-generator *mt19937* 0)) (letm ((rng (random-number-generator *mt19937* 0))
(p #m(0.1d0 0.2d0 0.3d0 0.4d0)) (p #m(0.1d0 0.2d0 0.3d0 0.4d0))
(n (make-array* '(signed-byte 32) :dimensions 4))) (n (make-marray '(signed-byte 32) :dimensions 4)))
(multinomial rng 8 p n) (multinomial rng 8 p n)
(cl-array n)) (cl-array n))
(letm ((p #m(0.1d0 0.2d0 0.3d0 0.4d0)) (letm ((p #m(0.1d0 0.2d0 0.3d0 0.4d0))
......
;; Quasi-random sequences in arbitrary dimensions. ;; Quasi-random sequences in arbitrary dimensions.
;; Liam Healy, Sun Jul 16 2006 - 15:54 ;; Liam Healy, Sun Jul 16 2006 - 15:54
;; Time-stamp: <2008-12-25 22:49:26EST quasi.lisp> ;; Time-stamp: <2008-12-26 10:28:22EST quasi.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -82,7 +82,7 @@ ...@@ -82,7 +82,7 @@
(save-test quasi-random-number-generators (save-test quasi-random-number-generators
;; This example is given in the GSL documentation ;; This example is given in the GSL documentation
(letm ((gen (quasi-random-number-generator 2 *sobol*)) (letm ((gen (quasi-random-number-generator 2 *sobol*))
(vec (make-array* 'double-float :dimensions 2))) (vec (make-marray 'double-float :dimensions 2)))
(loop repeat 5 (loop repeat 5
do (qrng-get gen vec) do (qrng-get gen vec)
append (coerce (cl-array vec) 'list)))) append (coerce (cl-array vec) 'list))))
;; Shuffling and sampling ;; Shuffling and sampling
;; Liam Healy, Sat Dec 2 2006 - 18:40 ;; Liam Healy, Sat Dec 2 2006 - 18:40
;; Time-stamp: <2008-11-30 23:15:32EST shuffling-sampling.lisp> ;; Time-stamp: <2008-12-26 10:28:21EST shuffling-sampling.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -63,11 +63,11 @@ ...@@ -63,11 +63,11 @@
(cl-array v1)) (cl-array v1))
(letm ((rng (random-number-generator *mt19937* 0)) (letm ((rng (random-number-generator *mt19937* 0))
(v1 #31m(1 2 3 4 5 6 7 8)) (v1 #31m(1 2 3 4 5 6 7 8))
(v2 (make-array* '(signed-byte 32) :dimensions 4))) (v2 (make-marray '(signed-byte 32) :dimensions 4)))
(choose-random rng v2 v1) (choose-random rng v2 v1)
(cl-array v2)) (cl-array v2))
(letm ((rng (random-number-generator *mt19937* 0)) (letm ((rng (random-number-generator *mt19937* 0))
(v1 #31m(1 2 3 4 5 6 7 8)) (v1 #31m(1 2 3 4 5 6 7 8))
(v2 (make-array* '(signed-byte 32) :dimensions 10))) (v2 (make-marray '(signed-byte 32) :dimensions 10)))
(sample rng v2 v1) (sample rng v2 v1)
(cl-array v2))) (cl-array v2)))
;; Series acceleration. ;; Series acceleration.
;; Liam Healy, Wed Nov 21 2007 - 18:41 ;; Liam Healy, Wed Nov 21 2007 - 18:41
;; Time-stamp: <2008-12-23 22:10:48EST series-acceleration.lisp> ;; Time-stamp: <2008-12-26 10:25:49EST series-acceleration.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -127,7 +127,7 @@ ...@@ -127,7 +127,7 @@
(sum 0.0d0) (sum 0.0d0)
(zeta2 (/ (expt pi 2) 6))) (zeta2 (/ (expt pi 2) 6)))
(letm ((levin (levin maxterms)) (letm ((levin (levin maxterms))
(array (make-array* 'double-float :dimensions maxterms))) (array (make-marray 'double-float :dimensions maxterms)))
(dotimes (n maxterms) (dotimes (n maxterms)
(setf (maref array n) (coerce (/ (expt (1+ n) 2)) 'double-float)) (setf (maref array n) (coerce (/ (expt (1+ n) 2)) 'double-float))
(incf sum (maref array n))) (incf sum (maref array n)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment