From 2b5d10f0f5af33c9872d1dfbca5ca9c223cf8b82 Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Mon, 21 Jun 2004 02:02:39 +0000 Subject: [PATCH] Tests of floats and big rationals --- ansi-tests/number-comparison.lsp | 248 ++++++++++++++++++++++++++++++- 1 file changed, 247 insertions(+), 1 deletion(-) diff --git a/ansi-tests/number-comparison.lsp b/ansi-tests/number-comparison.lsp index 003ca327..e1ce4173 100644 --- a/ansi-tests/number-comparison.lsp +++ b/ansi-tests/number-comparison.lsp @@ -1342,4 +1342,250 @@ (list (list x i)))))) nil) -;;; To add ... comparisons of large rationals with floats \ No newline at end of file +(deftest bignum.float.compare.7 + (let ((toobig (loop for x in *reals* + collect (and (> (abs x) 1.0) + (> (abs (log (abs x))) 10000))))) + (loop for x in *reals* + for xtoobig in toobig + nconc + (unless xtoobig + (let ((fx (floor x))) + (loop for y in *reals* + for ytoobig in toobig + when (and (not ytoobig) + (< x y) + (or (not (< fx y)) + (<= y fx) + (not (> y fx)) + (>= fx y))) + collect (list x y)))))) + nil) + +(deftest bignum.float.compare.8 + (let ((toobig (loop for x in *reals* + collect (and (> (abs x) 1.0) + (> (abs (log (abs x))) 10000))))) + (loop for x in *reals* + for xtoobig in toobig + nconc + (unless xtoobig + (let ((fx (floor x))) + (loop for y in *reals* + for ytoobig in toobig + when (and (not ytoobig) + (<= x y) + (or (not (<= fx y)) + (> fx y) + (not (>= y fx)) + (< y fx))) + collect (list x y)))))) + nil) + +;;; More randomized comparisons + +(deftest bignum.short-float.random.compare.1 + (let* ((integer-bound (ash 1 1000)) + (upper-bound (if (< (/ most-positive-short-float 2) integer-bound) + (/ most-positive-short-float 2) + (coerce integer-bound 'short-float)))) + (loop for bound = 1.0s0 then (* bound 2) + while (<= bound upper-bound) + nconc + (loop for r = (random bound) + for fr = (floor r) + for cr = (ceiling r) + repeat 20 + unless (and (<= fr r cr) + (if (= r fr) + (= r cr) + (/= r cr)) + (>= cr r fr)) + collect (list r fr cr)))) + nil) + +(deftest bignum.single-float.random.compare.1 + (let* ((integer-bound (ash 1 100)) + (upper-bound (if (< (/ most-positive-single-float 2) integer-bound) + (/ most-positive-single-float 2) + (coerce integer-bound 'single-float)))) + (loop for bound = 1.0f0 then (* bound 2) + while (<= bound upper-bound) + nconc + (loop for r = (random bound) + for fr = (floor r) + for cr = (ceiling r) + repeat 20 + unless (and (<= fr r cr) + (if (= r fr) + (= r cr) + (/= r cr)) + (>= cr r fr)) + collect (list r fr cr)))) + nil) + +(deftest bignum.double-float.random.compare.1 + (let* ((integer-bound (ash 1 100)) + (upper-bound (if (< (/ most-positive-double-float 2) integer-bound) + (/ most-positive-double-float 2) + (coerce integer-bound 'double-float)))) + (loop for bound = 1.0d0 then (* bound 2) + while (<= bound upper-bound) + nconc + (loop for r = (random bound) + for fr = (floor r) + for cr = (ceiling r) + repeat 20 + unless (and (<= fr r cr) + (if (= r fr) + (= r cr) + (/= r cr)) + (>= cr r fr)) + collect (list r fr cr)))) + nil) + +(deftest bignum.long-float.random.compare.1 + (let* ((integer-bound (ash 1 100)) + (upper-bound (if (< (/ most-positive-long-float 2) integer-bound) + (/ most-positive-long-float 2) + (coerce integer-bound 'long-float)))) + (loop for bound = 1.0l0 then (* bound 2) + while (< bound upper-bound) + nconc + (loop for r = (random bound) + for fr = (floor r) + for cr = (ceiling r) + repeat 20 + unless (and (<= fr r cr) + (if (= r fr) + (= r cr) + (/= r cr)) + (>= cr r fr)) + collect + (list r fr cr)))) + nil) + +;;; Rational/float comparisons + +(deftest rational.short-float.random.compare.1 + (let* ((integer-bound (ash 1 1000)) + (upper-bound (if (< (/ most-positive-short-float 2) integer-bound) + (/ most-positive-short-float 2) + (coerce integer-bound 'short-float)))) + (loop for bound = 1.0s0 then (* bound 2) + while (<= bound upper-bound) + nconc + (loop for r = (+ 1.s0 (random bound)) + for fr = (floor r) + for cr = (ceiling r) + for m = (ash 1 (1+ (random 30))) + for p = (1+ (random m)) + for q = (1+ (random m)) + for x = 0 + repeat 50 + when (<= p q) do (psetf p (1+ q) q p) + do (setf x (/ p q)) + unless (let ((fr/x (/ fr x)) + (cr*x (* cr x))) + (and (<= fr/x r cr*x) + (< fr/x r cr*x) + (> cr*x r fr/x) + (>= cr*x r fr/x))) + collect (list r p q x fr cr)))) + nil) + +(deftest rational.single-float.random.compare.1 + (let* ((integer-bound (ash 1 1000)) + (upper-bound (if (< (/ most-positive-single-float 2) integer-bound) + (/ most-positive-single-float 2) + (coerce integer-bound 'single-float)))) + (loop for bound = 1.0f0 then (* bound 2) + while (<= bound upper-bound) + nconc + (loop for r = (+ 1.s0 (random bound)) + for fr = (floor r) + for cr = (ceiling r) + for m = (ash 1 (1+ (random 30))) + for p = (1+ (random m)) + for q = (1+ (random m)) + for x = 0 + repeat 50 + when (<= p q) do (psetf p (1+ q) q p) + do (setf x (/ p q)) + unless (let ((fr/x (/ fr x)) + (cr*x (* cr x))) + (and (<= fr/x r cr*x) + (< fr/x r cr*x) + (> cr*x r fr/x) + (>= cr*x r fr/x))) + collect (list r p q x fr cr)))) + nil) + +(deftest rational.double-float.random.compare.1 + (let* ((integer-bound (ash 1 1000)) + (upper-bound (if (< (/ most-positive-double-float 4) integer-bound) + (/ most-positive-double-float 4) + (coerce integer-bound 'double-float)))) + (loop for bound = 1.0d0 then (* bound 4) + while (<= bound upper-bound) + nconc + (loop for r = (+ 1.s0 (random bound)) + for fr = (floor r) + for cr = (ceiling r) + for m = (ash 1 (1+ (random 30))) + for p = (1+ (random m)) + for q = (1+ (random m)) + for x = 0 + repeat 50 + when (<= p q) do (psetf p (1+ q) q p) + do (setf x (/ p q)) + unless (let ((fr/x (/ fr x)) + (cr*x (* cr x))) + (and (<= fr/x r cr*x) + (< fr/x r cr*x) + (> cr*x r fr/x) + (>= cr*x r fr/x))) + collect (list r p q x fr cr)))) + nil) + +(deftest rational.long-float.random.compare.1 + (let* ((integer-bound (ash 1 1000)) + (upper-bound (if (< (/ most-positive-long-float 4) integer-bound) + (/ most-positive-long-float 4) + (coerce integer-bound 'long-float)))) + (loop for bound = 1.0d0 then (* bound 4) + while (<= bound upper-bound) + nconc + (loop for r = (+ 1.s0 (random bound)) + for fr = (floor r) + for cr = (ceiling r) + for m = (ash 1 (1+ (random 30))) + for p = (1+ (random m)) + for q = (1+ (random m)) + for x = 0 + repeat 50 + when (<= p q) do (psetf p (1+ q) q p) + do (setf x (/ p q)) + unless (let ((fr/x (/ fr x)) + (cr*x (* cr x))) + (and (<= fr/x r cr*x) + (< fr/x r cr*x) + (> cr*x r fr/x) + (>= cr*x r fr/x))) + collect (list r p q x fr cr)))) + nil) + + + + + + + + + + + + + + + -- GitLab