Commit 6a685571 authored by Liam Healy's avatar Liam Healy

Copy to and from CL arrays

The function #'copy will now copy contents between marrays and CL
arrays.  The destination array can be supplied literally, or created
by this function by specifying the desired type: when copying from a
marray to a CL array, specify 'array; when copying from a CL array to
a marray, specify the element type of the marray.  For example,
(COPY
   (COPY
    (MAKE-MARRAY '(COMPLEX DOUBLE-FLOAT) :INITIAL-CONTENTS
                 '((-34.5 8.24 3.29 -8.93 34.12 -6.15)
                   (-8.93 34.12 -6.15 49.27 -13.49 32.5)
                   (49.27 -13.49 32.5 42.73 -17.24 43.31)))
    'ARRAY)
   '(COMPLEX DOUBLE-FLOAT))
copies from the matrix-complex-double-float made in the make-marray
form to a CL array, then copies the contents to a new
matrix-complex-double-float.
parent 4670733d
;; Functions for both vectors and matrices.
;; Liam Healy 2008-04-26 20:48:44EDT both.lisp
;; Time-stamp: <2009-01-11 22:37:48EST both.lisp>
;; Time-stamp: <2009-02-11 22:17:09EST both.lisp>
;; $Id$
(in-package :gsl)
......@@ -53,16 +53,24 @@
:c-return :void
:documentation "Set all elements to 0.")
(defmfun copy
((source both)
&optional
(defmfun copy-to-destination
((source both) (destination both))
("gsl_" :category :type "_memcpy")
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :methods
:inputs (source)
:outputs (destination))
(defmfun copy-making-destination
((source both) &aux
(destination
(make-marray element-type :dimensions (dimensions source))))
("gsl_" :category :type "_memcpy")
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :methods
:inputs (source)
:outputs (destination))
:outputs (destination)
:return (destination))
(defmfun swap ((a both) (b both))
("gsl_" :category :type "_swap")
......
;; Copy marrays to/from CL arrays
;; Liam Healy 2009-02-11 19:28:44EST copy-cl.lisp
;; Time-stamp: <2009-02-11 23:00:07EST copy-cl.lisp>
;; $Id: $
;;; The function #'copy can be used to copy the contents to or from a
;;; CL array. If the destination isn't literally supplied, it can be
;;; a symbol 'array indicating that the marray is to be copied to a CL
;;; array, or an element type like 'double-float, indicating the
;;; contents of the CL array is to be copied to a new marray with the
;;; given element type.
;;; Contrast this with the function #'cl-array or the initarg
;;; :cl-array to #'make-marray. The function returns the cl-array
;;; without copying, and so might be faster but also makes the
;;; original marray object vulnerable if an element is changed, which
;;; officially has unpredictable results. Likewise, the initarg will
;;; use the given CL array directly in the created marray without
;;; copying.
(in-package :gsl)
(define-condition array-mismatch (error)
()
(:report
(lambda (condition stream)
(declare (ignore condition))
(format stream "Arrays must be of equal size for copying.")))
(:documentation
"An error indicating that the two arrays do not have
the same dimensions."))
(defmethod copy-to-destination ((source mvector) (destination array))
(unless (equal (dimensions source) (array-dimensions destination))
(error 'array-mismatch))
(loop for i below (dim0 source)
do (setf (aref destination i) (maref source i)))
destination)
(defmethod copy-to-destination ((source matrix) (destination array))
(unless (equal (dimensions source) (array-dimensions destination))
(error 'array-mismatch))
(loop for i below (dim0 source) do
(loop for j below (dim1 source) do
(setf (aref destination i j) (maref source i j))))
destination)
(defmethod copy-to-destination ((source array) (destination mvector))
(unless (equal (array-dimensions source) (dimensions destination))
(error 'array-mismatch))
(loop for i below (length source)
do (setf (maref destination i) (aref source i)))
destination)
(defmethod copy-to-destination ((source array) (destination matrix))
(unless (equal (array-dimensions source) (dimensions destination))
(error 'array-mismatch))
(loop for i below (array-dimension source 0) do
(loop for j below (array-dimension source 1) do
(setf (maref destination i j) (aref source i j))))
destination)
;;; These make destination but are methods of copy-to-destination so
;;; that the class argument may be supplied.
(defmethod copy-to-destination ((source marray) (destclass (eql 'array)))
(let ((destination
(make-ffa (element-type source) :dimensions (dimensions source))))
(copy-to-destination source destination)))
;;; Copy to a named marray element-type, where the type is a symbol
(defmethod copy-to-destination ((source array) (destclass symbol))
(let ((destination
(make-marray destclass :dimensions (array-dimensions source))))
(copy-to-destination source destination)))
;;; Copy to a named marray element-type, where the type is a list
(defmethod copy-to-destination ((source array) (destclass list))
(let ((destination
(make-marray destclass :dimensions (array-dimensions source))))
(copy-to-destination source destination)))
;;; Examples and tests
(generate-all-array-tests vector-copy-to-cl-and-back t
(cl-array (copy (copy (array-default 3) 'array) 'default-element-type)))
(generate-all-array-tests matrix-copy-to-cl-and-back t
(cl-array (copy (copy (array-default '(3 3)) 'array) 'default-element-type)))
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-01-28 20:59:16EST gsll-tests.asd>
;; Time-stamp: <2009-02-11 22:15:11EST gsll-tests.asd>
;; $Id$
(asdf:defsystem "gsll-tests"
......@@ -91,6 +91,7 @@
(:file "lu")
(:file "mathematical")
(:file "matrix-copy")
(:file "matrix-copy-to-cl-and-back")
(:file "matrix-div")
(:file "matrix-max-index")
(:file "matrix-max")
......@@ -166,6 +167,7 @@
(:file "transport")
(:file "trigonometry")
(:file "vector-copy")
(:file "vector-copy-to-cl-and-back")
(:file "vector-div")
(:file "vector-max-index")
(:file "vector-max")
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-01-28 21:05:10EST gsll.asd>
;; Time-stamp: <2009-02-11 21:17:38EST gsll.asd>
;; $Id$
(asdf:defsystem "gsll"
......@@ -47,6 +47,7 @@
(:file "matrix" :depends-on (marray vector))
(:file "maref" :depends-on (marray vector matrix))
(:file "both" :depends-on (marray vector matrix))
(:file "copy-cl")
(:file "array-tests" :depends-on (both))
(:file "permutation" :depends-on (marray))
(:file "combination" :depends-on (marray))))
......
;; Define examples.
;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp
;; Time-stamp: <2008-12-29 19:10:39EST generate-examples.lisp>
;; Time-stamp: <2009-02-11 22:44:32EST generate-examples.lisp>
;; $Id: $
;;; Define examples that can be displayed by users with the function
......@@ -163,7 +163,7 @@
(declare (special default-element-type starting-element))
(setf starting-element 0)
(stupid-code-walk-eval-some
test
(subst det 'default-element-type test)
'(array-default scalar-default)))))
(defmacro generate-all-array-tests (name element-types test)
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2009-01-28 19:19:54EST mobject.lisp>
;; Time-stamp: <2009-02-11 22:17:38EST mobject.lisp>
;;; GSL objects are represented in GSLL as and instance of a 'mobject.
;;; The macro demobject takes care of defining the appropriate
......@@ -179,13 +179,11 @@
;;;;****************************************************************************
(export 'copy)
(defgeneric copy (object &optional destination)
(:documentation "Create a duplicate object.")
;; This method is used for all GSL objects except arrays.
(:method ((object mobject) &optional destination)
(if destination
(copy-to-destination object destination)
(copy-making-destination object))))
(defun copy (object &optional destination)
"Create a duplicate object."
(if destination
(copy-to-destination object destination)
(copy-making-destination object)))
(defgeneric copy-to-destination (object destination)
;; This copies values into an existing object. Methods are defined
......@@ -198,19 +196,21 @@
(defgeneric copy-making-destination (object)
(:documentation "Create new duplicate object.")
(:method :around ((object mobject))
(if (next-method-p)
;; The subclass method should only return the malloced
;; mpointer (as from a "_clone" function); it will be put into
;; the CL object here. The initial-instance method for these
;; objects must be written to do nothing if the mpointer is
;; already defined.
;; Defined for
;; histogram, histogram2d,
;; random-number-generator, quasi-random-number-generator,
(make-instance (class-of object) :mpointer (call-next-method))
;; The subclass does not supply a method, so this will be called
;; by default. We can only try to make something from the load form.
(eval (make-load-form object)))))
(if (next-method-p)
;; The subclass method should only return the malloced
;; mpointer (as from a "_clone" function); it will be put into
;; the CL object here. The initial-instance method for these
;; objects must be written to do nothing if the mpointer is
;; already defined.
;; Defined for
;; histogram, histogram2d,
;; random-number-generator, quasi-random-number-generator,
(if (typep object 'marray)
(call-next-method)
(make-instance (class-of object) :mpointer (call-next-method)))
;; The subclass does not supply a method, so this will be called
;; by default. We can only try to make something from the load form.
(eval (make-load-form object)))))
;;; Could be part of copy when the second argument is optional?
(export 'clone)
......
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