From 89c807df0588e5b540e6d1ebcb031609946fe77b Mon Sep 17 00:00:00 2001 From: "Thomas M. Hermann" Date: Wed, 4 Mar 2009 19:41:17 +0000 Subject: [PATCH] [project @ Implemented an equality function for significant figures.] --- lisp-unit.lisp | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/lisp-unit.lisp b/lisp-unit.lisp index bf23ea8..167ef55 100644 --- a/lisp-unit.lisp +++ b/lisp-unit.lisp @@ -109,6 +109,7 @@ For more information, see lisp-unit.html. #:logically-equal #:set-equal #:float-equal #:complex-equal #:number-equal #:array-equal + #:significant-figures-equal #:use-debugger #:with-test-listener) ) @@ -525,6 +526,26 @@ comparison." (when (dimensions-equal array1 array2) (element-equal array1 array2 nil (array-dimensions array1) epsilon))) +;;; (NORMALIZE-FLOAT significand &optional exponent) => significand,exponent +(defun normalize-float (significand &optional (exponent 0)) + "Return the normalized floating point number and exponent." + (cond + ((> (abs significand) 10) + (normalize-float (* significand 0.10) (1+ exponent))) + ((< (abs significand) 1) + (normalize-float (* significand 10.0) (1- exponent))) + (t (values significand exponent)))) + +;;; (SIGNIFICANT-FIGURES-EQUAL float1 float2 significant-figures) => true or false +(defun significant-figures-equal (float1 float2 significant-figures) + "Return true if the floating point numbers have equal significant +figures." + (multiple-value-bind (sig1 exp1) (normalize-float float1) + (multiple-value-bind (sig2 exp2) (normalize-float float2) + (and (= exp1 exp2) + (< (abs (- sig1 sig2)) + (* (float 5 float1) (expt (float 10 float2) (- significant-figures)))))))) + ;;;; References ;;;; [NumLinAlg] James W. Demmel "Applied Numerical Linear Algebra", ;;;; Society for Industrial and Applied Mathematics, 1997 -- 2.11.4.GIT