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 ;; top-level
  21 (deftestsuite
  22     lisp-stat-ut () ()
  23     (:documentation "top level CLS unittests."))
  24
  25 ;;; Support for fine-grained numerical equivalence
  26
  27 (defun almost= (a b &key (tol 0.000001))
  28   "Numerically compares 2 values to a tolerance."
  29    (< (abs (- a b)) tol))
  30
  31 (defun almost=lists (a b &key (tol 0.000001))
  32   "Numerically compare 2 lists using almost=."
  33   (if (and (null a) (null b))
  34       t
  35       (and (almost= (car a) (car b) :tol tol)
  36            (almost=lists (cdr a) (cdr b) :tol tol))))
  37
  38 ;; Need to consider a CLOSy approach for almost= to cover the range of
  39 ;; possible data structures that we would like to be equal to a
  40 ;; particular tolerance range.  For example, fill in a shell like:
  41
  42 (defgeneric numerical= (a b &key tol))
  43
  44 (defmethod numerical= ((a real) (b real) &key (tol 0.00001)) ;; real))
  45   ;;(print (format nil " equality pred for real a=~w real b=~w" a b))
  46   (< (abs (- a b)) tol))
  47
  48 ;; can we just worry about reals if integers are a subclass?
  49 (defmethod numerical= ((a integer) (b integer) &key (tol 0.1)) ;; real))
  50   ;;(print (format nil " equality pred for int a=~w int b=~w" a b))
  51   (< (abs (- a b)) tol))
  52
  53 (defmethod numerical= ((a complex) (b complex) &key (tol 0.00001))
  54   ;;(print (format nil " equality pred for cmplx a=~w cmplx b=~w" a b))
  55   (< (abs (- a b)) tol))
  56
  57 (defmethod numerical= ((a sequence) (b sequence) &key (tol 0.00001))
  58   ;; (print (format nil "checking equality for list a ~w list b=~w" a b))
  59   ;; using sequence for lists and vectors, but not arrays.
  60   ;; FIXME++++  This is too slow, too many comparisons!
  61   (if (and (null a) (null b))
  62       t
  63       (if (and (= (length a) (length b))
  64                (> (length a) 0)
  65                (numerical= (car a) (car b) :tol tol))
  66           (progn
  67             (if (= (length (cdr a)) 0)
  68                 t
  69                 (numerical= (cdr a) (cdr b) :tol tol)))
  70           nil)))
  71
  72 ;; To do.
  73
  74 (defmethod numerical= ((a array) (b array) &key (tol 0.00001))
  75 ;;   (print (format nil
  76 ;;               "checking equality for array a ~w and array b=~w"
  77 ;;               a b))
  78   ;;; FIXME Warning!  Need to generalize past  2-d array!!
  79   (if (/= (array-dimensions a) (array-dimensions b))
  80       nil
  81       (let* ((a-dim (array-dimensions a))
  82              (a-b-elt-eq (loop for i from 0 to (nth 0 a-dim)
  83                                for j from 0 to (nth 1 a-dim)
  84                                collect (numerical= (apply #'aref a (list i j))
  85                                                    (apply #'aref b (list i j))
  86                                                    :tol tol))))
  87         (every #'(lambda (x) x) a-b-elt-eq))))
  88
  89 (deftestsuite lisp-stat-ut-testsupport (lisp-stat-ut)
  90   ()
  91   (:tests
  92    (almost=1 (ensure (almost= 3 3.001 :tol 0.01)))
  93    (almost=2 (ensure (almost= 3 3.01 :tol 0.01)))
  94    (almost=3 (ensure (not (almost= 3 3.1 :tol 0.01))))
  95    (almost=lists1 (ensure (almost=lists nil nil :tol 0.01)))
  96    (almost=lists2 (ensure (almost=lists (list ) (list ) :tol 0.01)))
  97    (almost=lists3 (ensure (almost=lists (list 1.0) (list 1.0) :tol 0.01)))
  98    (almost=lists4 (ensure (almost=lists (list 1.0 1.0) (list 1.0 1.0) :tol 0.01)))
  99    (almost=lists5 (ensure (not (almost=lists (list 1.0 1.0)
 100                                              (list 1.0 1.1) :tol 0.01))))))
 101
 102 (deftestsuite lisp-stat-ut-testsupport2 (lisp-stat-ut)
 103   ()
 104   (:tests
 105    (numerical=1 (ensure (numerical= 3 3.001 :tol 0.01)))
 106    (numerical=1.1 (ensure    (numerical= 2 2)))
 107    (numerical=1.2 (ensure (not (numerical= 2 3))))
 108    (numerical=2 (ensure (numerical= 3 3.01 :tol 0.01)))
 109    (numerical=3 (ensure (not (numerical= 3 3.1 :tol 0.01))))
 110    (numerical=4 (ensure (numerical= nil nil :tol 0.01)))
 111    (numerical=5 (ensure (numerical= (list ) (list ) :tol 0.01)))
 112    (numerical=6 (ensure (numerical= (list 1.0) (list 1.0) :tol 0.01)))
 113    (numerical=7 (ensure (numerical= (list 1.0 1.0) (list 1.0 1.0) :tol 0.01)))
 114    (numerical=7.5 (ensure-error (numerical= 1.0 (list 1.0 1.0) :tol 0.01)))
 115    (numerical=8 (ensure (not (numerical= (list 2.0 2.0 2.2) (list 2.1 2.0 2.2)))))
 116    (numerical=9 (ensure    (numerical= (list 2.1 2.0 2.2) (list 2.1 2.0 2.2)) ))
 117    (numerical=10 (ensure    (numerical= (list 2.1 2.0 2.2 4.2) (list 2.1 2.0 2.2 4.2))))
 118    (numerical=11 (ensure (not (numerical= (list 2.1 2.0 2.3 4.0) (list 2.1 2.0 2.2 4.0)))))
 119    (numerical=12 (ensure (not (numerical= (list 1.0 1.0)
 120                                          (list 1.0 1.1) :tol 0.01))))
 121    (numerical=C1 (ensure (numerical= #C(2 3) #C(2 3))))
 122    (numerical=C2 (ensure (not(numerical= #C(2 3) #C(2 4)))))
 123    (numerical=C3 (ensure (numerical= #C(2 3) #C(3 4) :tol 2)))
 124    (numerical=C4 (ensure (not(numerical= #C(2 3) #C(3 4) :tol 1))))
 125
 126    ;;;; Tests to fix
 127
 128    (numerical=A1 (ensure (numerical= #1A(2 3 4)
 129                                      #1A(2 3 4))))
 130
 131    (numerical=A2 (ensure (numerical= #2A((2 3 4) (1 2 4) (2 4 5))
 132                                      #2A((2 3 4) (1 2 4) (2 4 5)))))
 133
 134    (numerical=A3 (ensure (not (numerical= #2A((2 3 4) (1 2 4) (2 5 4))
 135                                           #2A((2 3 4) (1 2 4) (2 4 5))))))
 136
 137    (numerical=A4 (ensure (not (numerical= #1A(2 2 4)
 138                                           #1A(2 3 4)))))
 139
 140    ))
 141
 142 ;; (describe (run-tests :suite 'lisp-stat-ut-testsupport2))
 143
 144 #|
 145 (describe
 146  (run-test
 147   :test-case 'numerical=a2
 148   :suite 'lisp-stat-ut-testsupport2 ))
 149 |#
 150
 151
 152 #|
 153 (describe
 154  (run-test
 155   :test-case 'numerical=a1
 156   :suite 'lisp-stat-ut-testsupport2 ))
 157 |#
 158