diff --git a/auxiliary/ansi-aux.lsp b/auxiliary/ansi-aux.lsp index c22e294aad0b640800193bed4d5525d55404b487..6deac06f57fa1bd3b5d9de6cdb3821bddcb33c24 100644 --- a/auxiliary/ansi-aux.lsp +++ b/auxiliary/ansi-aux.lsp @@ -1137,6 +1137,9 @@ the condition to go uncaught if it cannot be classified." (defun approx= (x y &optional (eps (epsilon x))) (<= (abs (/ (- x y) (max (abs x) 1))) eps)) +(defun approx-eql (x y) + (and (approx= x y) (typep x (type-of y)))) + (defun epsilon (number) (etypecase number (complex (* 2 (epsilon (realpart number)))) ;; crude diff --git a/numbers/signum.lsp b/numbers/signum.lsp index 39edf5145feaeec809bb3631c12d905a13536033..61c48b563fa3b9989b0d94bcc056e99d967f025d 100644 --- a/numbers/signum.lsp +++ b/numbers/signum.lsp @@ -77,35 +77,35 @@ for c2 = (complex onem z) for c3 = (complex z one) for c4 = (complex z onem) - unless (eql c1 (signum c1)) + unless (approx-eql c1 (signum c1)) collect (list c1 (signum c1)) - unless (eql c2 (signum c2)) + unless (approx-eql c2 (signum c2)) collect (list c2 (signum c2)) - unless (eql c3 (signum c3)) + unless (approx-eql c3 (signum c3)) collect (list c3 (signum c3)) - unless (eql c4 (signum c4)) + unless (approx-eql c4 (signum c4)) collect (list c4 (signum c4))) nil) (deftest signum.8 (let* ((c (complex 0 1)) (s (signum c))) - (or (eqlt c s) - (eqlt s #c(0.0 1.0)))) + (or (approx-eql c s) + (approx-eql s #c(0.0 1.0)))) t) (deftest signum.9 (let* ((c (complex 0 -1)) (s (signum c))) - (or (eqlt c s) - (eqlt s #c(0.0 -1.0)))) + (or (approx-eql c s) + (approx-eql s #c(0.0 -1.0)))) t) (deftest signum.10 (let* ((c (complex 3/5 4/5)) (s (signum c))) - (or (eqlt c s) - (eqlt s (complex (float 3/5) (float 4/5))))) + (or (approx-eql c s) + (approx-eql s (complex (float 3/5) (float 4/5))))) t) (deftest signum.11