diff --git a/data/combination.lisp b/data/combination.lisp index 9dec8981dedb76b603c3ed6c30c1134a9e686717..2e1ad1b9a7a927db8ea5c66d11bfb30418fe9c8e 100644 --- a/data/combination.lisp +++ b/data/combination.lisp @@ -1,8 +1,8 @@ ;; 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 ;;;;**************************************************************************** diff --git a/data/permutation.lisp b/data/permutation.lisp index 5073620a6ef98ccb717a22968055ba3f3e46fcbe..bcaa660cd2bb7badc8a23b8d607b17293de458b4 100644 --- a/data/permutation.lisp +++ b/data/permutation.lisp @@ -1,8 +1,8 @@ ;; 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)) diff --git a/histogram/histogram.lisp b/histogram/histogram.lisp index 50857f377d36e0addba61efd07c2f476e93ad884..50aae82e3313f24736efabfca77c3c647f345e40 100644 --- a/histogram/histogram.lisp +++ b/histogram/histogram.lisp @@ -1,8 +1,8 @@ ;; 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))) diff --git a/init/forms.lisp b/init/forms.lisp index f72054e44a2d53a69ee0de1cf844d24175595398..31c22932470d833f641b8e70fe93b5fd28664524 100644 --- a/init/forms.lisp +++ b/init/forms.lisp @@ -1,8 +1,8 @@ ;; 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) diff --git a/init/init.lisp b/init/init.lisp index dac4fbc652ab8f6278ed40157a62c8b69050a704..e072aae17ee058e32fdaaac6f0802d8575fc3652 100644 --- a/init/init.lisp +++ b/init/init.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/init/mobject.lisp b/init/mobject.lisp index df8f58413a36c77faef9ba23d49fccd4e2ee528a..78d2883202b9b23114ebae55ea412ded882968a8 100644 --- a/init/mobject.lisp +++ b/init/mobject.lisp @@ -1,6 +1,6 @@ ;; 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))) -|# diff --git a/random/generators.lisp b/random/generators.lisp index 045b245ba3a85a66ccaf38c699afd369a54aefde..e938813e1f2596d8f3a30e6d19f4882a7e3ffcd9 100644 --- a/random/generators.lisp +++ b/random/generators.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/random/quasi.lisp b/random/quasi.lisp index 6544eba27e116de53d46c95342d565270b808b0e..2def9355ca0a33907a2db3c56259f44cd693b799 100644 --- a/random/quasi.lisp +++ b/random/quasi.lisp @@ -1,6 +1,6 @@ ;; 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 diff --git a/tests/permutation.lisp b/tests/permutation.lisp index 2ddb23753cca3497e9274326a536bce934557f65..435f0eb7b96ad6043114d36b043bc104f9e68b5e 100644 --- a/tests/permutation.lisp +++ b/tests/permutation.lisp @@ -1,6 +1,6 @@ ;; 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)))))