src/unittests/unittests.lisp

   1 ;;; -*- mode: lisp -*-
   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.
   5
   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
   9 ;;; determined.
  10
  11 (in-package :lisp-stat-unittests)
  12
  13 ;;; This file contains overall test support infrastructure.
  14
  15 (defun run-lisp-stat-tests ()
  16   (run-tests :suite 'lisp-stat-ut))
  17
  18 ;; (run-lisp-stat-tests)
  19
  20 (deftestsuite lisp-stat-ut () ())
  21
  22 ;;; Support for fine-grained numerical equivalence
  23
  24 (defun almost= (a b &key (tol 0.000001))
  25   "Numerically compares 2 values to a tolerance."
  26    (< (abs (- a b)) tol))
  27
  28 (defun almost=lists (a b &key (tol 0.000001))
  29   "Numerically compare 2 lists using almost=."
  30   (if (and (null a) (null b))
  31       t
  32       (and (almost= (car a) (car b) :tol tol)
  33            (almost=lists (cdr a) (cdr b) :tol tol))))
  34
  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:
  38
  39 (defgeneric numerical= (a b &key tol))
  40
  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))
  44
  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))
  49
  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))
  53
  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))
  59       t
  60       (if (and (= (length a) (length b))
  61                (> (length a) 0)
  62                (numerical= (car a) (car b) :tol tol))
  63           (progn
  64             (if (= (length (cdr a)) 0)
  65                 t
  66                 (numerical= (cdr a) (cdr b) :tol tol)))
  67           nil)))
  68
  69 ;; To do.
  70
  71 (defmethod numerical= ((a array) (b array) &key (tol 0.00001))
  72 ;;   (print (format nil
  73 ;;               "checking equality for array a ~w and array b=~w"
  74 ;;               a b))
  75   ;;; FIXME Warning!  Need to generalize past  2-d array!!
  76   (if (/= (array-dimensions a) (array-dimensions b))
  77       nil
  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))
  83                                                    :tol tol))))
  84         (every #'(lambda (x) x) a-b-elt-eq))))
  85
  86 (deftestsuite lisp-stat-ut-testsupport (lisp-stat-ut)
  87   ()
  88   (:tests
  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))))))
  98
  99 (deftestsuite lisp-stat-ut-testsupport2 (lisp-stat-ut)
 100   ()
 101   (:tests
 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))))
 122
 123    ;;;; Tests to fix
 124
 125    (numerical=A1 (ensure (numerical= #1A(2 3 4)
 126                                      #1A(2 3 4))))
 127
 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)))))
 130
 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))))))
 133
 134    (numerical=A4 (ensure (not (numerical= #1A(2 2 4)
 135                                           #1A(2 3 4)))))
 136
 137    ))
 138
 139 ;; (describe (run-tests :suite 'lisp-stat-ut-testsupport2))
 140
 141 #|
 142 (describe
 143  (run-test
 144   :test-case 'numerical=a2
 145   :suite 'lisp-stat-ut-testsupport2 ))
 146 |#
 147
 148
 149 #|
 150 (describe
 151  (run-test
 152   :test-case 'numerical=a1
 153   :suite 'lisp-stat-ut-testsupport2 ))
 154 |#
 155