2 ;;; Copyright (c) 2007, by A.J. Rossini <blindglobe@gmail.com>
3 ;;; See COPYRIGHT file for any additional restrictions (BSD license).
4 ;;; Since 1991, ANSI was finally finished. Edited for ANSI Common Lisp.
6 ;;; This is semi-external to lispstat core packages. The dependency
7 ;;; should be that lispstat packages are dependencies for the unit
8 ;;; tests. However, where they will end up is still to be
11 (in-package :lisp-stat-unittests
)
13 ;;; This file contains overall test support infrastructure.
15 (defun run-lisp-stat-tests ()
16 (run-tests :suite
'lisp-stat-ut
))
18 ;; (run-lisp-stat-tests)
20 (deftestsuite lisp-stat-ut
() ())
22 ;;; Support for fine-grained numerical equivalence
24 (defun almost= (a b
&key
(tol 0.000001))
25 "Numerically compares 2 values to a tolerance."
26 (< (abs (- a b
)) tol
))
28 (defun almost=lists
(a b
&key
(tol 0.000001))
29 "Numerically compare 2 lists using almost=."
30 (if (and (null a
) (null b
))
32 (and (almost= (car a
) (car b
) :tol tol
)
33 (almost=lists
(cdr a
) (cdr b
) :tol tol
))))
35 ;; Need to consider a CLOSy approach for almost= to cover the range of
36 ;; possible data structures that we would like to be equal to a
37 ;; particular tolerance range. For example, fill in a shell like:
39 (defgeneric numerical
= (a b
&key tol
))
41 (defmethod numerical= ((a real
) (b real
) &key
(tol 0.00001)) ;; real))
42 ;;(print (format nil " equality pred for real a=~w real b=~w" a b))
43 (< (abs (- a b
)) tol
))
45 ;; can we just worry about reals if integers are a subclass?
46 (defmethod numerical= ((a integer
) (b integer
) &key
(tol 0.1)) ;; real))
47 ;;(print (format nil " equality pred for int a=~w int b=~w" a b))
48 (< (abs (- a b
)) tol
))
50 (defmethod numerical= ((a complex
) (b complex
) &key
(tol 0.00001))
51 ;;(print (format nil " equality pred for cmplx a=~w cmplx b=~w" a b))
52 (< (abs (- a b
)) tol
))
54 (defmethod numerical= ((a sequence
) (b sequence
) &key
(tol 0.00001))
55 ;; (print (format nil "checking equality for list a ~w list b=~w" a b))
56 ;; using sequence for lists and vectors, but not arrays.
57 ;; FIXME++++ This is too slow, too many comparisons!
58 (if (and (null a
) (null b
))
60 (if (and (= (length a
) (length b
))
62 (numerical= (car a
) (car b
) :tol tol
))
64 (if (= (length (cdr a
)) 0)
66 (numerical= (cdr a
) (cdr b
) :tol tol
)))
71 (defmethod numerical= ((a array
) (b array
) &key
(tol 0.00001))
73 ;; "checking equality for array a ~w and array b=~w"
75 ;;; FIXME Warning! Need to generalize past 2-d array!!
76 (if (/= (array-dimensions a
) (array-dimensions b
))
78 (let* ((a-dim (array-dimensions a
))
79 (a-b-elt-eq (loop for i from
0 to
(nth 0 a-dim
)
80 for j from
0 to
(nth 1 a-dim
)
81 collect
(numerical= (apply #'aref a
(list i j
))
82 (apply #'aref b
(list i j
))
84 (every #'(lambda (x) x
) a-b-elt-eq
))))
86 (deftestsuite lisp-stat-ut-testsupport
(lisp-stat-ut)
89 (almost=1 (ensure (almost= 3 3.001 :tol
0.01)))
90 (almost=2 (ensure (almost= 3 3.01 :tol
0.01)))
91 (almost=3 (ensure (not (almost= 3 3.1 :tol
0.01))))
92 (almost=lists1
(ensure (almost=lists nil nil
:tol
0.01)))
93 (almost=lists2
(ensure (almost=lists
(list ) (list ) :tol
0.01)))
94 (almost=lists3
(ensure (almost=lists
(list 1.0) (list 1.0) :tol
0.01)))
95 (almost=lists4
(ensure (almost=lists
(list 1.0 1.0) (list 1.0 1.0) :tol
0.01)))
96 (almost=lists5
(ensure (not (almost=lists
(list 1.0 1.0)
97 (list 1.0 1.1) :tol
0.01))))))
99 (deftestsuite lisp-stat-ut-testsupport2
(lisp-stat-ut)
102 (numerical=1 (ensure (numerical= 3 3.001 :tol
0.01)))
103 (numerical=1.1 (ensure (numerical= 2 2)))
104 (numerical=1.2 (ensure (not (numerical= 2 3))))
105 (numerical=2 (ensure (numerical= 3 3.01 :tol
0.01)))
106 (numerical=3 (ensure (not (numerical= 3 3.1 :tol
0.01))))
107 (numerical=4 (ensure (numerical= nil nil
:tol
0.01)))
108 (numerical=5 (ensure (numerical= (list ) (list ) :tol
0.01)))
109 (numerical=6 (ensure (numerical= (list 1.0) (list 1.0) :tol
0.01)))
110 (numerical=7 (ensure (numerical= (list 1.0 1.0) (list 1.0 1.0) :tol
0.01)))
111 (numerical=7.5 (ensure-error (numerical= 1.0 (list 1.0 1.0) :tol
0.01)))
112 (numerical=8 (ensure (not (numerical= (list 2.0 2.0 2.2) (list 2.1 2.0 2.2)))))
113 (numerical=9 (ensure (numerical= (list 2.1 2.0 2.2) (list 2.1 2.0 2.2)) ))
114 (numerical=10 (ensure (numerical= (list 2.1 2.0 2.2 4.2) (list 2.1 2.0 2.2 4.2))))
115 (numerical=11 (ensure (not (numerical= (list 2.1 2.0 2.3 4.0) (list 2.1 2.0 2.2 4.0)))))
116 (numerical=12 (ensure (not (numerical= (list 1.0 1.0)
117 (list 1.0 1.1) :tol
0.01))))
118 (numerical=C1
(ensure (numerical= #C
(2 3) #C
(2 3))))
119 (numerical=C2
(ensure (not(numerical= #C
(2 3) #C
(2 4)))))
120 (numerical=C3
(ensure (numerical= #C
(2 3) #C
(3 4) :tol
2)))
121 (numerical=C4
(ensure (not(numerical= #C
(2 3) #C
(3 4) :tol
1))))
125 (numerical=A1
(ensure (numerical= #1A
(2 3 4)
128 (numerical=A2
(ensure (numerical= #2A
((2 3 4) (1 2 4) (2 4 5))
129 #2A
((2 3 4) (1 2 4) (2 4 5)))))
131 (numerical=A3
(ensure (not (numerical= #2A
((2 3 4) (1 2 4) (2 5 4))
132 #2A
((2 3 4) (1 2 4) (2 4 5))))))
134 (numerical=A4
(ensure (not (numerical= #1A
(2 2 4)
139 ;; (describe (run-tests :suite 'lisp-stat-ut-testsupport2))
144 :test-case
'numerical
=a2
145 :suite
'lisp-stat-ut-testsupport2
))
152 :test-case
'numerical
=a1
153 :suite
'lisp-stat-ut-testsupport2
))