generalize gcd' and lcm' to work on rationals

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)]{

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))

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
 

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];
+  return (is_rational(argv[0]) ? scheme_true : scheme_false);
-
-  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);
 }
 
 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, gcd, "gcd", scheme_bin_gcd, 0, is_rational, "rational", int_abs)
-GEN_NARY_OP(static, lcm, "lcm", bin_lcm, 1, scheme_is_integer, "integer", 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);
 }