Commit a1747969 authored by Marius Gerbershagen's avatar Marius Gerbershagen

numbers: fix signum tests to use approximate equal comparison

parent 9f06631f
...@@ -1137,6 +1137,9 @@ the condition to go uncaught if it cannot be classified." ...@@ -1137,6 +1137,9 @@ the condition to go uncaught if it cannot be classified."
(defun approx= (x y &optional (eps (epsilon x))) (defun approx= (x y &optional (eps (epsilon x)))
(<= (abs (/ (- x y) (max (abs x) 1))) eps)) (<= (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) (defun epsilon (number)
(etypecase number (etypecase number
(complex (* 2 (epsilon (realpart number)))) ;; crude (complex (* 2 (epsilon (realpart number)))) ;; crude
......
...@@ -77,35 +77,35 @@ ...@@ -77,35 +77,35 @@
for c2 = (complex onem z) for c2 = (complex onem z)
for c3 = (complex z one) for c3 = (complex z one)
for c4 = (complex z onem) for c4 = (complex z onem)
unless (eql c1 (signum c1)) unless (approx-eql c1 (signum c1))
collect (list c1 (signum c1)) collect (list c1 (signum c1))
unless (eql c2 (signum c2)) unless (approx-eql c2 (signum c2))
collect (list c2 (signum c2)) collect (list c2 (signum c2))
unless (eql c3 (signum c3)) unless (approx-eql c3 (signum c3))
collect (list c3 (signum c3)) collect (list c3 (signum c3))
unless (eql c4 (signum c4)) unless (approx-eql c4 (signum c4))
collect (list c4 (signum c4))) collect (list c4 (signum c4)))
nil) nil)
(deftest signum.8 (deftest signum.8
(let* ((c (complex 0 1)) (let* ((c (complex 0 1))
(s (signum c))) (s (signum c)))
(or (eqlt c s) (or (approx-eql c s)
(eqlt s #c(0.0 1.0)))) (approx-eql s #c(0.0 1.0))))
t) t)
(deftest signum.9 (deftest signum.9
(let* ((c (complex 0 -1)) (let* ((c (complex 0 -1))
(s (signum c))) (s (signum c)))
(or (eqlt c s) (or (approx-eql c s)
(eqlt s #c(0.0 -1.0)))) (approx-eql s #c(0.0 -1.0))))
t) t)
(deftest signum.10 (deftest signum.10
(let* ((c (complex 3/5 4/5)) (let* ((c (complex 3/5 4/5))
(s (signum c))) (s (signum c)))
(or (eqlt c s) (or (approx-eql c s)
(eqlt s (complex (float 3/5) (float 4/5))))) (approx-eql s (complex (float 3/5) (float 4/5)))))
t) t)
(deftest signum.11 (deftest signum.11
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment