suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

generalize gcd' and lcm' to work on rationals

Browse Source
This commit is contained in:
Matthew Flatt 2011-12-08 09:10:34 -07:00
parent 7e666b4b45
commit 657be87c66
4 changed files with 54 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/scribblings/reference/numbers.scrbl
View File

@ -363,23 +363,28 @@ Returns the smallest of the @racket[x]s, or @racket[+nan.0] if any
@mz-examples[(min 1 3 2) (min 1 3 2.0)]}
@defproc[(gcd [n integer?] ...) integer?]{
@defproc[(gcd [n rational?] ...) rational?]{
Returns the @as-index{greatest common divisor} (a non-negative
number) of the @racket[n]s. If no arguments are provided, the result
number) of the @racket[n]s; for non-integer @racket[n]s, the result
is the @racket[gcd] of the numerators divided
by the @racket[lcm] of the denominators.
If no arguments are provided, the result
is @racket[0]. If all arguments are zero, the result is zero.
@mz-examples[(gcd 10) (gcd 12 81.0)]}
@mz-examples[(gcd 10) (gcd 12 81.0) (gcd 1/2 1/3)]}
@defproc[(lcm [n integer?] ...) integer?]{
@defproc[(lcm [n rational?] ...) rational?]{
Returns the @as-index{least common multiple} (a non-negative number)
of the @racket[n]s. If no arguments are provided, the result is
of the @racket[n]s; non-integer @racket[n]s, the result is
the absolute value of the product divided by the
@racket[gcd]. If no arguments are provided, the result is
@racket[1]. If any argument is zero, the result is zero; furthermore,
if any argument is exact @racket[0], the result is exact @racket[0].
@mz-examples[(lcm 10) (lcm 3 4.0)]}
@mz-examples[(lcm 10) (lcm 3 4.0) (lcm 1/2 2/3)]}
@defproc[(round [x real?]) (or/c integer? +inf.0 -inf.0 +nan.0)]{

20
collects/tests/racket/number.rktl
View File

@ -1292,6 +1292,20 @@
(test (* (expt 2 37) (expt 9 35)) lcm (- (expt 9 35)) (expt 6 37))
(test (* (expt 2 37) (expt 9 35)) lcm (expt 9 35) (- (expt 6 37)))
(test 1/2 gcd 1/2)
(test 1/2 gcd 3 1/2)
(test 1/2 gcd 1/2 3)
(test 1/105 gcd 1/3 2/5 3/7)
(test 0.5 gcd 0.5 3)
(test 0.5 gcd 1/2 3.0)
(test 1/2 lcm 1/2)
(test 3 lcm 3 1/2)
(test 3 lcm 1/2 3)
(test 2/3 lcm 1/3 2/3)
(test 6 lcm 1/3 2/5 3/7)
(test 3.0 lcm 0.5 3)
(test 3.0 lcm 1/2 3.0)
(err/rt-test (gcd +nan.0))
(err/rt-test (gcd +inf.0))
(err/rt-test (gcd -inf.0))
@ -1304,12 +1318,6 @@
(err/rt-test (lcm 'a))
(err/rt-test (lcm 'a 1))
(err/rt-test (lcm 1 'a))
(err/rt-test (gcd 1/2))
(err/rt-test (gcd 3 1/2))
(err/rt-test (gcd 1/2 3))
(err/rt-test (lcm 1/2))
(err/rt-test (lcm 3 1/2))
(err/rt-test (lcm 1/2 3))
(err/rt-test (gcd 1+2i))
(err/rt-test (lcm 1+2i))
(err/rt-test (gcd 1 1+2i))

1
doc/release-notes/racket/HISTORY.txt
View File

@ -1,6 +1,7 @@
Version 5.2.0.5
Cross-module inlining of trivial functions, plus map, for-each,
andmap, and ormap; 'compiler-hint:cross-module-inline hint
Generalize gcd and lcm to work on rationals
compiler/zo-structs: added inline-variant
racket/stream: added stream constructor

37
src/racket/src/number.c
View File

@ -1239,15 +1239,18 @@ real_p(int argc, Scheme_Object *argv[])
return (SCHEME_REALP(o) ? scheme_true : scheme_false);
}
static int is_rational(const Scheme_Object *o)
{
if (SCHEME_FLOATP(o))
return rational_dbl_p(SCHEME_FLOAT_VAL(o));
else
return SCHEME_REALP(o);
}
static Scheme_Object *
rational_p(int argc, Scheme_Object *argv[])
{
Scheme_Object *o = argv[0];
if (SCHEME_FLOATP(o))
return (rational_dbl_p(SCHEME_FLOAT_VAL(o)) ? scheme_true : scheme_false);
else
return (SCHEME_REALP(o) ? scheme_true : scheme_false);
return (is_rational(argv[0]) ? scheme_true : scheme_false);
}
int scheme_is_integer(const Scheme_Object *o)
@ -1507,8 +1510,8 @@ static Scheme_Object *int_abs(Scheme_Object *v)
return v;
}
GEN_NARY_OP(static, gcd, "gcd", scheme_bin_gcd, 0, scheme_is_integer, "integer", int_abs)
GEN_NARY_OP(static, lcm, "lcm", bin_lcm, 1, scheme_is_integer, "integer", int_abs)
GEN_NARY_OP(static, gcd, "gcd", scheme_bin_gcd, 0, is_rational, "rational", int_abs)
GEN_NARY_OP(static, lcm, "lcm", bin_lcm, 1, is_rational, "rational", int_abs)
Scheme_Object *
scheme_bin_gcd (const Scheme_Object *n1, const Scheme_Object *n2)
@ -1536,6 +1539,22 @@ scheme_bin_gcd (const Scheme_Object *n1, const Scheme_Object *n2)
b = r;
}
return (scheme_make_integer(a));
} else if (!scheme_is_integer(n1) || !scheme_is_integer(n2)) {
Scheme_Object *n1a, *n2a, *a[1], *num;
a[0] = (Scheme_Object *)n1;
n1a = numerator(1, a);
a[0] = (Scheme_Object *)n2;
n2a = numerator(1, a);
num = scheme_bin_gcd(n1a, n2a);
a[0] = (Scheme_Object *)n1;
n1a = denominator(1, a);
a[0] = (Scheme_Object *)n2;
n2a = denominator(1, a);
n1a = bin_lcm(n1a, n2a);
return scheme_bin_div(num, n1a);
} else if (SCHEME_FLOATP(n1) || SCHEME_FLOATP(n2)) {
double i1, i2, a, b, r;
#ifdef MZ_USE_SINGLE_FLOATS
@ -1620,7 +1639,7 @@ bin_lcm (Scheme_Object *n1, Scheme_Object *n2)
if (scheme_is_zero(d))
return d;
ret = scheme_bin_mult(n1, scheme_bin_quotient(n2, d));
ret = scheme_bin_mult(n1, scheme_bin_div(n2, d));
return scheme_abs(1, &ret);
}