From a06bb10aef08cbfe22d6e38052ff512b36079b0f Mon Sep 17 00:00:00 2001 From: AJ Rossini Date: Fri, 16 Nov 2007 09:39:42 +0100 Subject: [PATCH] Array tests, version 1. Needs work. Examples to ls-demo --- ls-demo.lisp | 57 +++++++++++++++++++++++++++++++++++++++++++++++++++++ unittests.lisp | 62 +++++++++++++++++++++++++++++++++++++++++++++++----------- 2 files changed, 108 insertions(+), 11 deletions(-) diff --git a/ls-demo.lisp b/ls-demo.lisp index 650e7f2..c5ebb86 100644 --- a/ls-demo.lisp +++ b/ls-demo.lisp @@ -284,3 +284,60 @@ absorbtion (def m (regression-model (list iron aluminum) absorbtion)) (send m :help) (send m :plot-residuals) + + +;;; Example array calcs + +#+nil(progn + (functionp #'and) + (= (array-dimensions #2A((2 3 3 ) (2 4 4))) + (array-dimensions #2A((2 3 3 ) (2 5 4)))) + (reduce #'and (= (array-dimensions #2A((2 3) (2 4))) + (array-dimensions #2A((2 3 3 ) (2 5 4))))) + + (defvar my-t-ar nil) + (setf my-t-ar #3A(((2 3) (2 2) (2 1)) + ((2 3) (2 2) (2 1)))) + (defvar my-t-ar2 nil) + (setf my-t-ar2 #2A((1 2 3 4) + (5 6 7 8))) + + (array-dimensions my-t-ar) + (array-dimensions my-t-ar2) + + (aref my-t-ar2 1 2) ;; GOOD + (aref my-t-ar2 (list 1 2)) ;; BAD + (apply #'aref my-t-ar2 (list 1 2)) ;; GOOD + ;; For extracting multiple elements + (mapcar #'(lambda (x) (apply #'aref my-t-ar2 x)) + (list (list 0 0) (list 0 1))) + + + (aref my-t-ar 1 2 1) + (aref my-t-ar 1 2 1) + (aref my-t-ar 1 1 0) + + (array-dimensions #3A(((2 3) (2 2) (2 1)) + ((2 3) (2 2) (2 1)))) + + (reduce #'and (= #(2 3) #(2 4))) + (= #(2 3) #(2 3)) + +(let ((a #2A((2 3 3 ) (2 5 4))) + (b #2A((2 3 3 ) (2 5 4)))) + (let ((a-rank (array-rank a)) + (a-dim (array-dimensions a)) + (a-b-elt-eq (loop for i in 0 to (aref a-dim 0) + for j in 0 to (aref a-dim 1) + collect (numerical= (apply #'aref a (list i j)) + (apply #'aref b (list i j)))))) + (every #'(lambda (x) x) a-b-elt-eq)))) + +(every #'(lambda (x) x) (list T T T)) +(every #'(lambda (x) x) (list T T nil)) + + (and T T) + (mapcar #'(lambda (&rest args) (and args)) + (list (= #(2 3) #(2 4)))) + (= #(2 3) #(2 3)) + ) diff --git a/unittests.lisp b/unittests.lisp index 6faddf5..274b68f 100644 --- a/unittests.lisp +++ b/unittests.lisp @@ -68,13 +68,13 @@ ;;(print (format nil " equality pred for int a=~w int b=~w" a b)) (< (abs (- a b)) tol)) -;;(defmethod numerical= ((a complex) (b complex) &key (tol 0.00001)) ;; real)) -;; (< (abs (- a b)) tol)) - +(defmethod numerical= ((a complex) (b complex) &key (tol 0.00001)) + ;;(print (format nil " equality pred for cmplx a=~w cmplx b=~w" a b)) + (< (abs (- a b)) tol)) (defmethod numerical= ((a sequence) (b sequence) &key (tol 0.00001)) - (print (format nil "checking equality for list a ~w list b=~w" a b)) - ;; using sequence for both array and lists -- need to check multi-dim arrays + ;; (print (format nil "checking equality for list a ~w list b=~w" a b)) + ;; using sequence for lists and vectors, but not arrays. ;; FIXME++++ This is too slow, too many comparisons! (if (and (null a) (null b)) t @@ -87,11 +87,20 @@ (numerical= (cdr a) (cdr b) :tol tol))) nil))) -;; (defmethod numerical= ((complex a) (complex b) &key (tol 0.00001)) -;; (defmethod numerical= ((list a) (list b) &key (tol 0.00001)) -;; (defmethod numerical= ((array a) (array b) &key (tol 0.00001)) - - +;; To do. + +(defmethod numerical= ((a array) (b array) &key (tol 0.00001)) + (print (format nil "checking equality for array a ~w and array b=~w" a b)) + ;;; FIXME Warning! Need to generalize past 2-d array!! + (if (/= (array-dimensions a) (array-dimensions b)) + nil + (let* ((a-dim (array-dimensions a)) + (a-b-elt-eq (loop for i from 0 to (nth 0 a-dim) + for j from 0 to (nth 1 a-dim) + collect (numerical= (apply #'aref a (list i j)) + (apply #'aref b (list i j)) + :tol tol)))) + (every #'(lambda (x) x) a-b-elt-eq)))) (deftestsuite lisp-stat-testsupport (lisp-stat) () @@ -124,7 +133,29 @@ (numerical=10 (ensure (numerical= (list 2.1 2.0 2.2 4.2) (list 2.1 2.0 2.2 4.2)))) (numerical=11 (ensure (not (numerical= (list 2.1 2.0 2.3 4.0) (list 2.1 2.0 2.2 4.0))))) (numerical=12 (ensure (not (numerical= (list 1.0 1.0) - (list 1.0 1.1) :tol 0.01)))))) + (list 1.0 1.1) :tol 0.01)))) + (numerical=C1 (ensure (numerical= #C(2 3) #C(2 3)))) + (numerical=C2 (ensure (not(numerical= #C(2 3) #C(2 4))))) + (numerical=C3 (ensure (numerical= #C(2 3) #C(3 4) :tol 2))) + (numerical=C4 (ensure (not(numerical= #C(2 3) #C(3 4) :tol 1)))) + + ;;;; Tests to fix + + (numerical=A1 (ensure (numerical= #1A(2 3 4) + #1A(2 3 4)))) + + (numerical=A2 (ensure (numerical= #2A((2 3 4) (1 2 4) (2 4 5)) + #2A((2 3 4) (1 2 4) (2 4 5))))) + + (numerical=A3 (ensure (not (numerical= #2A((2 3 4) (1 2 4) (2 5 4)) + #2A((2 3 4) (1 2 4) (2 4 5)))))) + + (numerical=A4 (ensure (not (numerical= #1A(2 2 4) + #1A(2 3 4))))) + + )) + +;; (describe (run-tests :suite 'lisp-stat-testsupport2)) @@ -137,6 +168,15 @@ 5.000000000000003) :test 'almost=lists)) +;(addtest (lisp-stat-lin-alg) cholesky-decomposition-1a +; (ensure-same +; (chol-decomp #2A((2 3 4) (1 2 4) (2 4 5))) +; (list #2A((1.7888543819998317 0.0 0.0) +; (1.6770509831248424 0.11180339887498929 0.0) +; (2.23606797749979 2.23606797749979 3.332000937312528e-8)) +; 5.000000000000003) +; :test 'numerical=)) + (addtest (lisp-stat-lin-alg) lu-decomposition (ensure-same (lu-decomp #2A((2 3 4) (1 2 4) (2 4 5))) -- 2.11.4.GIT