diff --git a/data/array-tests.lisp b/data/array-tests.lisp index 471e0f8e5cfd6965717d8a8f90701d94659f180b..04d189b309d2bbea562b010f68104ffa74ac158d 100644 --- a/data/array-tests.lisp +++ b/data/array-tests.lisp @@ -1,36 +1,66 @@ ;; Tests of array functions ;; Liam Healy 2008-10-20 22:41:48EDT array-tests.lisp -;; Time-stamp: <2008-11-02 13:18:30EST array-tests.lisp> +;; Time-stamp: <2008-11-02 18:07:27EST array-tests.lisp> ;; $Id: $ +;;; Generate each file with #'write-test-to-file, e.g. +;;; (write-test-to-file 'matrix-set-zero "../test/") + (in-package :gsl) ;;; Some of these don't work for complex because: ;;; Cannot pass complex scalars to and from GSL functions (structs passed by value). (generate-all-array-tests - set-all-m+ :no-complex - (letm ((v1 (vector-default 3 t)) - (v2 (vector-default 3))) - (set-all v1 (scalar-default 2)) + vector-set-all-m+ :no-complex + (letm ((v1 (array-default 3 t)) + (v2 (array-default 3))) + (set-all v1 (scalar-default)) (cl-array (m+ v1 v2)))) (generate-all-array-tests - set-zero t - (letm ((v1 (vector-default 3))) + matrix-set-all-m+ :no-complex + (letm ((m1 (array-default '(3 3) t)) + (m2 (array-default '(3 3)))) + (set-all m1 (scalar-default)) + (cl-array (m+ m1 m2)))) + +(generate-all-array-tests + vector-set-zero t + (letm ((v1 (array-default 3))) (set-zero v1) (cl-array v1))) (generate-all-array-tests - array-copy t - (letm ((v1 (vector-default 3)) - (v2 (vector-default 3 t))) + matrix-set-zero t + (letm ((m1 (array-default '(3 3)))) + (set-zero m1) + (cl-array m1))) + +(generate-all-array-tests + vector-copy t + (letm ((v1 (array-default 3)) + (v2 (array-default 3 t))) (copy v2 v1) (cl-array v2))) (generate-all-array-tests - array-swap t - (letm ((v1 (vector-default 3)) - (v2 (vector-default 3))) + matrix-copy t + (letm ((m1 (array-default '(3 3))) + (m2 (array-default '(3 3) t))) + (copy m2 m1) + (cl-array m2))) + +(generate-all-array-tests + vector-swap t + (letm ((v1 (array-default 3)) + (v2 (array-default 3))) (swap v2 v1) - (concatenate 'vector (cl-array v1) (cl-array v2)))) + (list (cl-array v1) (cl-array v2)))) + +(generate-all-array-tests + matrix-swap t + (letm ((m1 (array-default '(3 3))) + (m2 (array-default '(3 3)))) + (swap m2 m1) + (list (cl-array m1) (cl-array m2)))) diff --git a/data/both.lisp b/data/both.lisp index 3d3da0d5281e7ad40b1e8903c87dc141ec031c44..28daa7c094a1627f0ee1a010976aec013936d76f 100644 --- a/data/both.lisp +++ b/data/both.lisp @@ -1,6 +1,6 @@ ;; Functions for both vectors and matrices. ;; Liam Healy 2008-04-26 20:48:44EDT both.lisp -;; Time-stamp: <2008-08-28 21:41:15EDT both.lisp> +;; Time-stamp: <2008-11-02 18:00:49EST both.lisp> ;; $Id$ (in-package :gsl) @@ -76,7 +76,8 @@ ;;; These functions are here as debugging tools only; they do not insure ;;; coherency between the C and CL sides and therefore should not be ;;; used in production. -(defmfun set-value ((object both) index value) +;;; For matrix functions, there should be another index argument +(defmfun set-value ((object vector) index value) ("gsl_" :category :type "_set") (((mpointer object) :pointer) (index sizet) (value :element-c-type)) :definition :generic @@ -87,7 +88,7 @@ :documentation "Set single element to the value. For debugging only; do not use.") -(defmfun get-value ((object both) index) +(defmfun get-value ((object vector) index) ("gsl_" :category :type "_get") (((mpointer object) :pointer) (index sizet)) :definition :generic diff --git a/data/data.lisp b/data/data.lisp index 38db03a2f26f728397c5749823f9e4916047b005..21f79743a896efcffd86c9eb0f43feb78ac78a54 100644 --- a/data/data.lisp +++ b/data/data.lisp @@ -1,6 +1,6 @@ ;; Data using ffa ;; Liam Healy 2008-04-06 21:23:41EDT data-ffa.lisp -;; Time-stamp: <2008-11-02 12:50:17EST data.lisp> +;; Time-stamp: <2008-11-02 17:38:20EST data.lisp> ;; $Id$ (in-package :gsl) @@ -164,7 +164,8 @@ (typep (if matrixp (caar cont) (first cont)) 'real)))) (when complex-with-real-init (assert - (evenp (length cont)) (cont) + (evenp (length (if matrixp (first cont) cont))) + (cont) "Complex arrays require initial contents of even length.")) (make-array* (if matrixp diff --git a/init/generate-tests.lisp b/init/generate-tests.lisp index 22e9b284146ccf0e58a44e520a59eb36f9b23d42..4d9a030f615d67d836a50fdd6ea1cb2aadf1596b 100644 --- a/init/generate-tests.lisp +++ b/init/generate-tests.lisp @@ -1,6 +1,6 @@ ;; Make tests and examples ;; Liam Healy 2008-09-07 21:00:48EDT generate-tests.lisp -;; Time-stamp: <2008-11-02 10:56:53EST generate-tests.lisp> +;; Time-stamp: <2008-11-02 17:50:39EST generate-tests.lisp> ;; $Id: $ (in-package :gsl) @@ -108,11 +108,12 @@ ;;; (loop repeat 50 collect (coerce (- (/ (random 10000) 100) 50) 'double-float)) (defparameter *double-float-pool* - '(-37.61 -48.84 -48.86 29.32 2.43 10.83 20.93 -15.27 11.26 -9.16 38.5 25.53 - -25.72 -13.99 -10.95 -0.71 36.53 -24.44 -21.79 -17.01 11.59 -37.64 -20.97 - -44.42 42.09 -46.72 13.32 -37.18 25.98 -21.06 40.78 21.35 43.15 9.23 - 31.73 33.38 -48.95 -42.69 22.95 -47.97 37.37 3.01 -3.53 -38.5 -12.8 42.14 - -6.44 29.57 -34.1 -11.98) + '(-34.5d0 8.24d0 3.29d0 -8.93d0 34.12d0 -6.15d0 49.27d0 -13.49d0 32.5d0 + 42.73d0 -17.24d0 43.31d0 -16.12d0 -8.25d0 21.44d0 -49.08d0 -39.66d0 + -49.46d0 19.68d0 -5.55d0 -8.82d0 25.37d0 -30.58d0 31.67d0 29.36d0 + -33.24d0 -27.03d0 -41.67d0 42.0d0 -20.81d0 37.93d0 -30.02d0 11.41d0 + 22.0d0 33.43d0 42.97d0 -36.7d0 -9.69d0 10.18d0 -47.96d0 37.42d0 -42.55d0 + 40.77d0 18.19d0 -43.66d0 -9.3d0 -29.79d0 -38.88d0 -45.6d0 -31.91d0) "A sequence of random double floats ranging between -100.0d0 and +100.0d0.") ;;; (loop repeat 50 collect (random 256)) @@ -141,34 +142,53 @@ "Make a list for :initial-contents of the specified element type and length using the pool data for the type and starting at the specified point in the pool." - (subseq - (cond ((subtypep type 'unsigned-byte) *unsigned-byte-pool*) - ((subtypep type 'signed-byte) *signed-byte-pool*) - ((subtypep type 'float) *double-float-pool*) - ((subtypep type 'complex) *double-float-pool*)) - starting - (+ starting (if (subtypep type 'complex) (* 2 length) length)))) + (mapcar + (lambda (num) (coerce num (component-float-type type))) + (subseq + (cond ((subtypep type 'unsigned-byte) *unsigned-byte-pool*) + ((subtypep type 'signed-byte) *signed-byte-pool*) + ((subtypep type 'float) *double-float-pool*) + ((subtypep type 'complex) *double-float-pool*)) + starting + (+ starting (if (subtypep type 'complex) (* 2 length) length))))) ;;;;**************************************************************************** ;;;; Generate forms for all array types ;;;;**************************************************************************** -(defun vector-default (spec &optional no-init sync-on-exit) +(defun array-default (spec &optional no-init sync-on-exit) + "Make an array of the current type and intialize from the pool." + (declare (special default-element-type starting-element)) + (let ((matrixp (listp spec))) + `(,(data-class-name (if matrixp 'matrix 'vector) default-element-type) + ,(if no-init + `',spec ; no initial values, just dimension + (cons ; macro to make initial-contents + 'a + (if matrixp + (loop repeat (first spec) + collect + (make-list-from-pool + default-element-type (second spec) starting-element) + do + (incf starting-element (second spec))) + (prog1 + (make-list-from-pool + default-element-type spec starting-element) + (incf starting-element spec))))) + ,sync-on-exit))) + +(defun scalar-default () + "Make a scalar of the current type from the pool." (declare (special default-element-type starting-element)) (prog1 - `(,(data-class-name 'vector default-element-type) - ,(if no-init - spec ; no initial values, just dimension - (cons ; macro to make initial-contents - 'a - (make-list-from-pool default-element-type spec starting-element))) - ,sync-on-exit) - (incf starting-element spec))) - -(defun scalar-default (spec) - (declare (special default-element-type)) - (coerce spec default-element-type)) + (if (subtypep default-element-type 'complex) + (apply #'complex + (make-list-from-pool default-element-type 1 starting-element)) + (first + (make-list-from-pool default-element-type 1 starting-element))) + (incf starting-element))) (defun stupid-code-walk-eval-some (form eval-list) "Walk the form and if the first symbol of the list is a member of @@ -189,7 +209,7 @@ (collect (stupid-code-walk-eval-some test - '(vector-default scalar-default))))) + '(array-default vector-default scalar-default))))) (defmacro generate-all-array-tests (name element-types test) `(save-test ,name ,@(generate-all-array-tests-body element-types test)))