diff --git a/collects/scribblings/reference/numbers.scrbl b/collects/scribblings/reference/numbers.scrbl index c91e58095a..2d16d55a42 100644 --- a/collects/scribblings/reference/numbers.scrbl +++ b/collects/scribblings/reference/numbers.scrbl @@ -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)]{ diff --git a/collects/tests/racket/number.rktl b/collects/tests/racket/number.rktl index 15a9c0991f..4d73e280ff 100644 --- a/collects/tests/racket/number.rktl +++ b/collects/tests/racket/number.rktl @@ -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)) diff --git a/doc/release-notes/racket/HISTORY.txt b/doc/release-notes/racket/HISTORY.txt index 4ff38aae7b..bfa0f3b62d 100644 --- a/doc/release-notes/racket/HISTORY.txt +++ b/doc/release-notes/racket/HISTORY.txt @@ -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 diff --git a/src/racket/src/number.c b/src/racket/src/number.c index 368cb0f7e3..dc41eb30ff 100644 --- a/src/racket/src/number.c +++ b/src/racket/src/number.c @@ -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); }