* min,max frac exact compare
@ 2004-04-15 0:43 Kevin Ryde
0 siblings, 0 replies; only message in thread
From: Kevin Ryde @ 2004-04-15 0:43 UTC (permalink / raw)
[-- Attachment #1: Type: text/plain, Size: 322 bytes --]
Fractions with min and max previously mentioned.
* numbers.c (scm_max, scm_min): For inum/frac, frac/inum, big/frac,
frac/big and frac/frac, use scm_less_p for exact comparison.
* tests/numbers.test (max, min): Exercise some inum/frac, frac/inum,
big/frac, frac/big and frac/frac cases.
[-- Attachment #2: numbers.c.min-max-frac.diff --]
[-- Type: text/plain, Size: 2757 bytes --]
--- numbers.c.~1.232.~ 2004-04-06 10:14:09.000000000 +1000
+++ numbers.c 2004-04-13 15:21:21.000000000 +1000
@@ -3546,8 +3546,8 @@
}
else if (SCM_FRACTIONP (y))
{
- double z = xx;
- return (z > scm_i_fraction2double (y)) ? x : y;
+ use_less:
+ return (SCM_FALSEP (scm_less_p (x, y)) ? x : y);
}
else
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
@@ -3577,11 +3577,7 @@
}
else if (SCM_FRACTIONP (y))
{
- double yy = scm_i_fraction2double (y);
- int cmp;
- cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), yy);
- scm_remember_upto_here_1 (x);
- return (cmp > 0) ? x : y;
+ goto use_less;
}
else
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
@@ -3621,16 +3617,11 @@
{
if (SCM_INUMP (y))
{
- double z = SCM_INUM (y);
- return (scm_i_fraction2double (x) < z) ? y : x;
+ goto use_less;
}
else if (SCM_BIGP (y))
{
- double xx = scm_i_fraction2double (x);
- int cmp;
- cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), xx);
- scm_remember_upto_here_1 (y);
- return (cmp < 0) ? x : y;
+ goto use_less;
}
else if (SCM_REALP (y))
{
@@ -3639,9 +3630,7 @@
}
else if (SCM_FRACTIONP (y))
{
- double yy = scm_i_fraction2double (y);
- double xx = scm_i_fraction2double (x);
- return (xx < yy) ? y : x;
+ goto use_less;
}
else
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
@@ -3689,8 +3678,8 @@
}
else if (SCM_FRACTIONP (y))
{
- double z = xx;
- return (z < scm_i_fraction2double (y)) ? x : y;
+ use_less:
+ return (SCM_FALSEP (scm_less_p (x, y)) ? y : x);
}
else
SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
@@ -3720,11 +3709,7 @@
}
else if (SCM_FRACTIONP (y))
{
- double yy = scm_i_fraction2double (y);
- int cmp;
- cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (x), yy);
- scm_remember_upto_here_1 (x);
- return (cmp > 0) ? y : x;
+ goto use_less;
}
else
SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min);
@@ -3764,16 +3749,11 @@
{
if (SCM_INUMP (y))
{
- double z = SCM_INUM (y);
- return (scm_i_fraction2double (x) < z) ? x : y;
+ goto use_less;
}
else if (SCM_BIGP (y))
{
- double xx = scm_i_fraction2double (x);
- int cmp;
- cmp = xmpz_cmp_d (SCM_I_BIG_MPZ (y), xx);
- scm_remember_upto_here_1 (y);
- return (cmp < 0) ? y : x;
+ goto use_less;
}
else if (SCM_REALP (y))
{
@@ -3782,9 +3762,7 @@
}
else if (SCM_FRACTIONP (y))
{
- double yy = scm_i_fraction2double (y);
- double xx = scm_i_fraction2double (x);
- return (xx < yy) ? x : y;
+ goto use_less;
}
else
SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max);
[-- Attachment #3: numbers.test.min-max-frac.diff --]
[-- Type: text/plain, Size: 2805 bytes --]
--- numbers.test.~1.45.~ 2004-03-27 19:11:43.000000000 +1000
+++ numbers.test 2004-04-13 15:29:50.000000000 +1000
@@ -1952,12 +1952,28 @@
(big*4 (* fixnum-max 4))
(big*5 (* fixnum-max 5)))
+ (with-test-prefix "inum / frac"
+ (pass-if (= 3 (max 3 5/2)))
+ (pass-if (= 5/2 (max 2 5/2))))
+
+ (with-test-prefix "frac / inum"
+ (pass-if (= 3 (max 5/2 3)))
+ (pass-if (= 5/2 (max 5/2 2))))
+
(with-test-prefix "inum / real"
(pass-if (nan? (max 123 +nan.0))))
(with-test-prefix "real / inum"
(pass-if (nan? (max +nan.0 123))))
+ (with-test-prefix "big / frac"
+ (pass-if (= big*2 (max big*2 5/2)))
+ (pass-if (= 5/2 (max (- big*2) 5/2))))
+
+ (with-test-prefix "frac / big"
+ (pass-if (= big*2 (max 5/2 big*2)))
+ (pass-if (= 5/2 (max 5/2 (- big*2)))))
+
(with-test-prefix "big / real"
(pass-if (nan? (max big*5 +nan.0)))
(pass-if (= big*5 (max big*5 -inf.0)))
@@ -1974,6 +1990,12 @@
(pass-if (inexact? (max 1.0 big*5)))
(pass-if (= (exact->inexact big*5) (max 1.0 big*5))))
+ (with-test-prefix "frac / frac"
+ (pass-if (= 2/3 (max 1/2 2/3)))
+ (pass-if (= 2/3 (max 2/3 1/2)))
+ (pass-if (= -1/2 (max -1/2 -2/3)))
+ (pass-if (= -1/2 (max -2/3 -1/2))))
+
(with-test-prefix "real / real"
(pass-if (nan? (max 123.0 +nan.0)))
(pass-if (nan? (max +nan.0 123.0)))
@@ -2057,12 +2079,28 @@
(pass-if
(= (- fixnum-min 1) (min 2 4 3 (* 2 fixnum-max) (- fixnum-min 1))))
+ (with-test-prefix "inum / frac"
+ (pass-if (= 5/2 (min 3 5/2)))
+ (pass-if (= 2 (min 2 5/2))))
+
+ (with-test-prefix "frac / inum"
+ (pass-if (= 5/2 (min 5/2 3)))
+ (pass-if (= 2 (min 5/2 2))))
+
(with-test-prefix "inum / real"
(pass-if (nan? (min 123 +nan.0))))
(with-test-prefix "real / inum"
(pass-if (nan? (min +nan.0 123))))
+ (with-test-prefix "big / frac"
+ (pass-if (= 5/2 (min big*2 5/2)))
+ (pass-if (= (- big*2) (min (- big*2) 5/2))))
+
+ (with-test-prefix "frac / big"
+ (pass-if (= 5/2 (min 5/2 big*2)))
+ (pass-if (= (- big*2) (min 5/2 (- big*2)))))
+
(with-test-prefix "big / real"
(pass-if (nan? (min big*5 +nan.0)))
(pass-if (= big*5 (min big*5 +inf.0)))
@@ -2079,6 +2117,12 @@
(pass-if (inexact? (min 1.0 (- big*5))))
(pass-if (= (exact->inexact (- big*5)) (min 1.0 (- big*5)))))
+ (with-test-prefix "frac / frac"
+ (pass-if (= 1/2 (min 1/2 2/3)))
+ (pass-if (= 1/2 (min 2/3 1/2)))
+ (pass-if (= -2/3 (min -1/2 -2/3)))
+ (pass-if (= -2/3 (min -2/3 -1/2))))
+
(with-test-prefix "real / real"
(pass-if (nan? (min 123.0 +nan.0)))
(pass-if (nan? (min +nan.0 123.0)))
[-- Attachment #4: Type: text/plain, Size: 142 bytes --]
_______________________________________________
Guile-devel mailing list
Guile-devel@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-devel
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2004-04-15 0:43 UTC | newest]
Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2004-04-15 0:43 min,max frac exact compare Kevin Ryde
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).