Skip to content
Snippets Groups Projects
Commit 73421c7c authored by pfdietz's avatar pfdietz
Browse files

Added more epsilon tests, this time using binary search to find the actual...

Added more epsilon tests, this time using binary search to find the actual minimum values satisfying the tests.
parent 08f7266b
No related branches found
No related tags found
No related merge requests found
......@@ -1536,3 +1536,29 @@ the condition to go uncaught if it cannot be classified."
(unwind-protect (eval ',form) (return-from done :good))
(condition () :good))))
:good))
;;; Binary search on reals
(defun float-binary-search (fn lo hi)
"FN is a function that, if true for X, is true for all Y > X.
Find the smallest float in [lo,hi] for which the function
return true."
(assert (functionp fn))
(assert (floatp lo))
(assert (floatp hi))
(assert (<= lo hi))
(assert (funcall fn hi))
(loop while (<= lo hi)
do (let ((mid (/ (+ lo hi) 2)))
(if (funcall fn mid)
(if (= mid hi)
(return hi)
(setq hi mid))
(if (= mid lo)
(return hi)
(setq lo mid))))))
\ No newline at end of file
......@@ -35,4 +35,90 @@
long-float-negative-epsilon)
unless (= (float 1 e) (- (float 1 e) (/ e 2)))
collect e)
nil)
\ No newline at end of file
nil)
(deftest epsilons.5
(loop for (type var) in
'(
(short-float short-float-epsilon)
(short-float short-float-negative-epsilon)
(single-float single-float-epsilon)
(single-float single-float-negative-epsilon)
(double-float double-float-epsilon)
(double-float double-float-negative-epsilon)
(long-float long-float-epsilon)
(long-float long-float-negative-epsilon))
for val = (symbol-value var)
unless (typep val type)
collect (list type var val))
nil)
(deftest epsilons.6
(flet ((%check (x) (/= 1.0s0 (+ 1.0s0 x))))
(let ((eps (float-binary-search #'%check 0.0s0 1.0s0)))
(if (= eps short-float-epsilon)
:good
(list eps short-float-epsilon))))
:good)
(deftest epsilons.7
(flet ((%check (x) (/= 1.0f0 (+ 1.0f0 x))))
(let ((eps (float-binary-search #'%check 0.0f0 1.0f0)))
(if (= eps single-float-epsilon)
:good
(list eps single-float-epsilon))))
:good)
(deftest epsilons.8
(flet ((%check (x) (/= 1.0d0 (+ 1.0d0 x))))
(let ((eps (float-binary-search #'%check 0.0d0 1.0d0)))
(if (= eps double-float-epsilon)
:good
(list eps double-float-epsilon))))
:good)
(deftest epsilons.9
(flet ((%check (x) (/= 1.0l0 (+ 1.0l0 x))))
(let ((eps (float-binary-search #'%check 0.0l0 1.0l0)))
(if (= eps long-float-epsilon)
:good
(list eps long-float-epsilon))))
:good)
(deftest epsilons.10
(flet ((%check (x) (/= 1.0s0 (- 1.0s0 x))))
(let ((eps (float-binary-search #'%check 0.0s0 1.0s0)))
(if (= eps short-float-negative-epsilon)
:good
(list eps short-float-negative-epsilon))))
:good)
(deftest epsilons.11
(flet ((%check (x) (/= 1.0f0 (- 1.0f0 x))))
(let ((eps (float-binary-search #'%check 0.0f0 1.0f0)))
(if (= eps single-float-negative-epsilon)
:good
(list eps single-float-negative-epsilon))))
:good)
(deftest epsilons.12
(flet ((%check (x) (/= 1.0d0 (- 1.0d0 x))))
(let ((eps (float-binary-search #'%check 0.0d0 1.0d0)))
(if (= eps double-float-negative-epsilon)
:good
(list eps double-float-negative-epsilon))))
:good)
(deftest epsilons.13
(flet ((%check (x) (/= 1.0l0 (- 1.0l0 x))))
(let ((eps (float-binary-search #'%check 0.0l0 1.0l0)))
(if (= eps long-float-negative-epsilon)
:good
(list eps long-float-negative-epsilon))))
:good)
\ No newline at end of file
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment