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

Copy with #'grid:copy methods

Copy with #'grid:copy methods and eliminate copy-to-destination and
copy-making-destination.  For non-grid objects, the presence or
absence of destination selects different foreign functions.
parent d10814a5
No related branches found
No related tags found
No related merge requests found
;; Combinations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2010-07-07 14:30:07EDT combination.lisp>
;; Time-stamp: <2010-07-15 23:06:33EDT combination.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Copyright 2006, 2007, 2008, 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -94,19 +94,29 @@
"Initialize the combination c to the lexicographically
last combination, i.e. (n-k,n-k+1,...,n-1).")
(defmfun grid::copy-to-destination ((source combination) (destination combination))
(defmfun comb-copy (source destination)
"gsl_combination_memcpy"
(((mpointer destination) :pointer)
((mpointer source) :pointer))
:definition :method
:inputs (source)
:outputs (destination)
:return (destination)
:index copy
:export nil
:index grid:copy
:documentation ; FDL
"Copy the elements of the combination source into the
combination destination. The two combinations must have the same size.")
(defmethod grid:copy
((source combination) &rest args &key grid-type destination &allow-other-keys)
(if grid-type
(call-next-method)
(comb-copy
source
:destination
(or destination
(make-combination (combination-range source) (size source))))))
;;;;****************************************************************************
;;;; Combination properties
;;;;****************************************************************************
......
;; Permutations
;; Liam Healy, Sun Mar 26 2006 - 11:51
;; Time-stamp: <2010-07-14 10:27:05EDT permutation.lisp>
;; Time-stamp: <2010-07-15 23:05:04EDT permutation.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Copyright 2006, 2007, 2008, 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -79,19 +79,26 @@
"Initialize the permutation p to the identity, i.e.
(0,1,2,...,n-1).")
(defmfun grid::copy-to-destination ((source permutation) (destination permutation))
(defmfun perm-copy (source destination)
"gsl_permutation_memcpy"
(((mpointer destination) :pointer)
((mpointer source) :pointer))
:definition :method
:inputs (source)
:outputs (destination)
:return (destination)
:index copy
:export nil
:index grid:copy
:documentation ; FDL
"Copy the elements of the permutation source into the
permutation destination. The two permutations must have the same size.")
(defmethod grid:copy
((source permutation) &rest args &key grid-type destination &allow-other-keys)
(if grid-type
(call-next-method)
(perm-copy
source :destination (or destination (make-permutation (size source))))))
(defmfun swap-elements ((p permutation) i j)
"gsl_permutation_swap"
(((mpointer p) :pointer) (i sizet) (j sizet))
......
;; The histogram structure
;; Liam Healy, Mon Jan 1 2007 - 11:32
;; Time-stamp: <2010-07-07 14:30:30EDT histogram.lisp>
;; Time-stamp: <2010-07-15 22:27:24EDT histogram.lisp>
;;
;; Copyright 2007, 2008, 2009 Liam M. Healy
;; Copyright 2007, 2008, 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -79,40 +79,52 @@
:definition :method
:return (histogram))
(defmfun grid::copy-to-destination ((source histogram) (destination histogram))
(defmfun histo-copy (source destination)
"gsl_histogram_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:return (destination)
:index copy
:export nil
:index grid:copy
:documentation ; FDL
"Copy the histogram source into the pre-existing
histogram destination, making the latter into
an exact copy of the former.
The two histograms must be of the same size.")
(defmfun grid::copy-to-destination ((source histogram2d) (destination histogram2d))
(defmfun histo-clone (source)
"gsl_histogram_clone"
(((mpointer source) :pointer))
:c-return (crtn :pointer)
:return ((make-instance 'histogram :mpointer crtn))
:export nil
:index grid:copy)
(defmethod grid:copy ((source histogram) &key destination &allow-other-keys)
(if destination
(histo-clone destination)
(histo-copy source)))
(defmfun histo2d-copy (source destination)
"gsl_histogram2d_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:return (destination)
:index copy
:export nil
:index grid:copy
:documentation ; FDL
"Copy the histogram source into the pre-existing
histogram destination, making the latter into
an exact copy of the former.
The two histograms must be of the same size.")
(defmfun grid::copy-making-destination ((source histogram))
"gsl_histogram_clone"
(((mpointer source) :pointer))
:definition :method
:c-return :pointer
:index copy)
(defmfun grid::copy-making-destination ((source histogram2d))
(defmfun histo2d-clone (source)
"gsl_histogram2d_clone"
(((mpointer source) :pointer))
:definition :method
:c-return :pointer
:index copy)
:c-return (crtn :pointer)
:return ((make-instance 'histogram2d :mpointer crtn))
:export nil
:index grid:copy)
(defmethod grid:copy ((source histogram2d) &key destination &allow-other-keys)
(if destination
(histo2d-clone destination)
(histo2d-copy source)))
;; Lisp forms
;; Liam Healy 2009-03-07 15:49:25EST forms.lisp
;; Time-stamp: <2010-07-13 22:32:44EDT forms.lisp>
;; Time-stamp: <2010-07-15 22:18:06EDT forms.lisp>
;;
;; Copyright 2009 Liam M. Healy
;; Copyright 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -24,7 +24,7 @@
;;;; Arglists
;;;;****************************************************************************
(defparameter *defmfun-llk* '(&optional &key &aux &rest)
(defparameter *defmfun-llk* '(&optional &key &aux &rest &allow-other-keys)
"Possible lambda-list keywords.")
(defparameter *defmfun-optk* '(&optional &key)
......
;; Load GSL
;; Liam Healy Sat Mar 4 2006 - 18:53
;; Time-stamp: <2010-07-01 21:39:45EDT init.lisp>
;; Time-stamp: <2010-07-15 22:26:30EDT init.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -25,11 +25,11 @@
:grid
#:cl-array #:dimensions #:element-type
#:foreign-array #:matrix #:dim0 #:dim1 #:^
#:copy #:clone)
#:copy)
(:shadowing-import-from :grid #:foreign-pointer)
(:export
#:cl-array #:dimensions #:element-type #:dim0 #:dim1
#:copy #:clone))
#:copy))
(cffi:define-foreign-library libgslcblas
(:darwin
......
;; Definition of GSL objects and ways to use them.
;; Liam Healy, Sun Dec 3 2006 - 10:21
;; Time-stamp: <2010-07-11 17:07:40EDT mobject.lisp>
;; Time-stamp: <2010-07-15 22:33:56EDT mobject.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -345,29 +345,3 @@
(export 'order)
(defgeneric order (object)
(:documentation "The order of the GSL object."))
;;;;****************************************************************************
;;;; Making objects from existing objects
;;;;****************************************************************************
#|
(defmethod grid::copy-making-destination :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,
(if (typep object 'grid:foreign-array)
(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))))
(defmethod grid:clone :around ((object mobject))
(make-instance (class-of object) :mpointer (call-next-method)))
|#
;; Generators of random numbers.
;; Liam Healy, Sat Jul 15 2006 - 14:43
;; Time-stamp: <2010-07-07 14:30:30EDT generators.lisp>
;; Time-stamp: <2010-07-15 22:43:39EDT generators.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -176,23 +176,29 @@
;;;; Copying state
;;;;****************************************************************************
(defmfun grid::copy-to-destination
((source random-number-generator) (destination random-number-generator))
(defmfun rng-copy (source destination)
"gsl_rng_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:index copy
:export nil
:index grid:copy
:documentation ; FDL
"Copy the random number generator source into the
pre-existing generator destination,
making destination into an exact copy
of source. The two generators must be of the same type.")
(defmfun grid::copy-making-destination ((instance random-number-generator))
"gsl_rng_clone" (((mpointer instance) :pointer))
:definition :method
:c-return :pointer
:index copy)
(defmfun rng-clone (source)
"gsl_rng_clone" (((mpointer source) :pointer))
:c-return (crtn :pointer)
:return ((make-instance 'random-number-generator :mpointer crtn))
:export nil
:index grid:copy)
(defmethod grid:copy
((source random-number-generator) &key destination &allow-other-keys)
(if destination
(rng-clone destination)
(rng-copy source)))
;;;;****************************************************************************
;;;; Examples and unit test
......
;; Quasi-random sequences in arbitrary dimensions.
;; Liam Healy, Sun Jul 16 2006 - 15:54
;; Time-stamp: <2010-07-07 14:30:06EDT quasi.lisp>
;; Time-stamp: <2010-07-15 22:41:48EDT quasi.lisp>
;;
;; Copyright 2006, 2007, 2008, 2009 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -64,23 +64,28 @@
:export nil
:index gsl-random-state)
(defmfun grid::copy-to-destination
((source quasi-random-number-generator)
(destination quasi-random-number-generator))
(defmfun quasi-copy (source destination)
"gsl_qrng_memcpy"
(((mpointer destination) :pointer) ((mpointer source) :pointer))
:definition :method
:index copy
:export nil
:index grid:copy
:documentation ; FDL
"Copy the quasi-random sequence generator src into the
pre-existing generator dest, making dest into an exact copy
of src. The two generators must be of the same type.")
(defmfun grid::copy-making-destination ((instance quasi-random-number-generator))
(defmfun quasi-clone (instance)
"gsl_qrng_clone" (((mpointer instance) :pointer))
:definition :method
:c-return :pointer
:index copy)
:c-return (crtn :pointer)
:return ((make-instance 'quasi-random-number-generator :mpointer crtn))
:export nil
:index grid:copy)
(defmethod grid:copy
((source quasi-random-number-generator) &key destination &allow-other-keys)
(if destination
(quasi-clone destination)
(quasi-copy source)))
(def-rng-type +niederreiter2+
;; FDL
......
;; Regression test PERMUTATION for GSLL, automatically generated
;;
;; Copyright 2009 Liam M. Healy
;; Copyright 2009, 2010 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -19,30 +19,22 @@
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST PERMUTATION
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 2)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T)))
(grid:gref PERM-1
2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(0 1 2 3))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T)))
(GRID:COPY-TO
PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(3 2 1 0))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T)))
(SET-IDENTITY
PERM-1)
(GRID:COPY-TO
(PERMUTATION-REVERSE
PERM-1)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
(grid:gref PERM-1 2))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(0 1 2 3))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
(GRID:COPY-TO PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(3 2 1 0))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(GRID:COPY-TO (PERMUTATION-REVERSE PERM-1)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(0 3 1 2))
(MULTIPLE-VALUE-LIST
......@@ -53,72 +45,44 @@
(permutation-next perm-1)
(permutation-next perm-1)
(grid:copy-to (permutation-inverse perm-1)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(0 3 2 1))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T)))
(SET-IDENTITY
PERM-1)
(SWAP-ELEMENTS
PERM-1 1 3)
(GRID:COPY-TO
PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST #(33 44 11 22))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T))
(INTVEC
(GRID:MAKE-FOREIGN-ARRAY
'(SIGNED-BYTE
32)
:INITIAL-CONTENTS
'(11 22 33
44))))
(SET-IDENTITY
PERM-1)
(SWAP-ELEMENTS
PERM-1 1 3)
(SWAP-ELEMENTS
PERM-1 0 2)
(PERMUTE
PERM-1 INTVEC)
(GRID:COPY-TO
INTVEC))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 3)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T)))
(SET-IDENTITY
PERM-1)
(SWAP-ELEMENTS
PERM-1 1 3)
(INVERSIONS
PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 3)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T)))
(SET-IDENTITY
PERM-1)
(SWAP-ELEMENTS
PERM-1 1 3)
(LINEAR-CYCLES
PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 2)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1
(MAKE-PERMUTATION
4 T)))
(SET-IDENTITY
PERM-1)
(SWAP-ELEMENTS
PERM-1 1 3)
(SWAP-ELEMENTS
PERM-1 0 2)
(CANONICAL-CYCLES
PERM-1)))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(0 3 2 1))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(GRID:COPY-TO PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST #(33 44 11 22))
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T))
(INTVEC (GRID:MAKE-FOREIGN-ARRAY '(SIGNED-BYTE 32)
:INITIAL-CONTENTS '(11 22 33 44))))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(SWAP-ELEMENTS PERM-1 0 2)
(PERMUTE PERM-1 INTVEC)
(GRID:COPY-TO INTVEC))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 3)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(INVERSIONS PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 3)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(LINEAR-CYCLES PERM-1))))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2)
(MULTIPLE-VALUE-LIST
(LET ((PERM-1 (MAKE-PERMUTATION 4 T)))
(SET-IDENTITY PERM-1)
(SWAP-ELEMENTS PERM-1 1 3)
(SWAP-ELEMENTS PERM-1 0 2)
(CANONICAL-CYCLES PERM-1)))))
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