anchor.diff: -;;;-*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
  -
  +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
  +;;;;
  +;;;; Additional LISP-UNIT tests and assertions
  +;;;;
  +;;;; Copyright (c) 2009, Thomas M. Hermann
  +;;;; All rights reserved.
  +;;;;
  +;;;; Redistribution and  use  in  source  and  binary  forms, with or without
  +;;;; modification, are permitted  provided  that the following conditions are
  +;;;; met:
  +;;;;
  +;;;;   o  Redistributions of  source  code  must  retain  the above copyright
  +;;;;      notice, this list of conditions and the following disclaimer.
  +;;;;   o  Redistributions in binary  form  must reproduce the above copyright
  +;;;;      notice, this list of  conditions  and  the  following disclaimer in
  +;;;;      the  documentation  and/or   other   materials  provided  with  the
  +;;;;      distribution.
  +;;;;   o  The names of the contributors may not be used to endorse or promote
  +;;;;      products derived from this software without  specific prior written
  +;;;;      permission.
  +;;;;
  +;;;; THIS SOFTWARE IS  PROVIDED  BY  THE  COPYRIGHT  HOLDERS AND CONTRIBUTORS
  +;;;; "AS IS"  AND  ANY  EXPRESS  OR  IMPLIED  WARRANTIES, INCLUDING,  BUT NOT
  +;;;; LIMITED TO, THE IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR A
  +;;;; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
  +;;;; OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  +;;;; EXEMPLARY, OR  CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT  NOT LIMITED TO,
  +;;;; PROCUREMENT OF  SUBSTITUTE  GOODS  OR  SERVICES;  LOSS  OF USE, DATA, OR
  +;;;; PROFITS; OR BUSINESS INTERRUPTION)  HOWEVER  CAUSED AND ON ANY THEORY OF
  +;;;; LIABILITY, WHETHER  IN  CONTRACT,  STRICT  LIABILITY, OR TORT (INCLUDING
  +;;;; NEGLIGENCE OR  OTHERWISE)  ARISING  IN  ANY  WAY  OUT OF THE USE OF THIS
  +;;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  +;;;;
   ;;;; References
   ;;;; [NumLinAlg] James W. Demmel "Applied Numerical Linear Algebra",
   ;;;;             Society for Industrial and Applied Mathematics, 1997
  
positive.code:   "Default to 4 significant figures.")
  
  ;;; (ROUNDOFF-ERROR x y) => number
  ;;; Return the error delta between the exact and approximate floating
  ;;; point value.
  ;;; [NumLinAlg] : Equation 1.1, pg. 12
  (defun roundoff-error (exact approximate)
    "Return the error delta between the exact and approximate floating
  point value."
    (abs (if (or (zerop exact) (zerop approximate))
  	   (+ exact approximate)
  	   (- (/ approximate exact) 1.0))))
  
  ;;; (FLOAT-EQUAL float1 float2 &optional epsilon) => true or false
  ;;; Return true if the absolute difference between float1 and float2
  ;;; is less than epsilon. If an epsilon is not specified and either
  ;;; float1 or float2 is single precision, the single-float-epsilon is
  ;;; used.
  (defun float-equal (float1 float2 &optional (epsilon *epsilon*))
    "Return true if the absolute difference between float1 and float2 is
  less than some epsilon."
    (and
     (floatp float1)
     (floatp float2)
     (cond
       ((and (zerop float1) (zerop float2)))
       (epsilon
        (> epsilon (roundoff-error float1 float2)))
       ((and (typep float1 'double-float) (typep float2 'double-float))
        (> (* 2.0 double-float-epsilon) (roundoff-error float1 float2)))
       ((or (typep float1 'single-float) (typep float2 'single-float))
        (> (* 2.0 single-float-epsilon) (roundoff-error float1 float2)))
       (t nil))))
  
  (defmacro assert-float-equal (expected form &rest extras)
    (expand-assert :equal form form expected extras :test #'float-equal))
  
  ;;; (COMPLEX-EQUAL complex1 complex2 &optional epsilon) => true or false
  ;;; Return true if the absolute difference of the real components and
  ;;; the absolute difference of the imaginary components is less then
  ;;; epsilon. If an epsilon is not specified and either complex1 or
  ;;; complex2 is (complex single-float), the single-float-epsilon is
  ;;; used.
  (defun complex-equal (complex1 complex2 &optional (epsilon *epsilon*))
    "Return true if the absolute difference between Re(complex1),
  Re(complex2) and the absolute difference between Im(complex1),
  
negative.code: 		 :test (lambda (f1 f2) (sigfig-equal f1 f2 significant-figures))))
  
  ;;; (ARRAY-EQUAL array1 array2) => true or false
  (defun array-equal (array1 array2 &key (test #'number-equal))
    "Return true if the elements of the array are equal."
    (when (equal (array-dimensions array1) (array-dimensions array2))
  