From 73421c7cf4ea987f47b9c71dcc1e7387809e8a5f Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Thu, 21 Aug 2003 23:10:53 +0000 Subject: [PATCH] Added more epsilon tests, this time using binary search to find the actual minimum values satisfying the tests. --- ansi-tests/ansi-aux.lsp | 26 ++++++++++++ ansi-tests/epsilons.lsp | 88 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 113 insertions(+), 1 deletion(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index ebd00858..fd5563dc 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -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 diff --git a/ansi-tests/epsilons.lsp b/ansi-tests/epsilons.lsp index 5bf80534..93be6468 100644 --- a/ansi-tests/epsilons.lsp +++ b/ansi-tests/epsilons.lsp @@ -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 -- GitLab