* fixed a bug in fldenominator

* added a file rationalize.ss that has the seed for the rationalize
  function

src/ikarus.numerics.ss

@@ -106,7 +106,7 @@
     (cond
       [($flonum-integer? x) 1.0]
       [($flonum-rational? x) 
-       (exact->inexact (numerator ($flonum->exact x)))]
+       (exact->inexact (denominator ($flonum->exact x)))]
       [(flnan? x) x]
       [else 1.0]))
 
@@ -1653,8 +1653,15 @@
             (values (fxquotient x y)
                     (fxremainder x y))]
            [(bignum? y) (values 0 x)]
-           [else (error 'quotient+remainder 
+           [(flonum? y) 
-                        "~s is not a number" y)])]
+            (let ([v ($flonum->exact y)])
+              (cond
+                [(or (fixnum? v) (bignum? v)) 
+                 (let-values ([(q r) (quotient+remainder x v)])
+                   (values (inexact q) (inexact r)))]
+                [else
+                 (error 'quotient+remainder "~s is not an integer" y)]))]
+           [else (error 'quotient+remainder "~s is not a number" y)])]
         [(bignum? x)
          (cond
            [(fixnum? y)
@@ -1663,10 +1670,23 @@
            [(bignum? y)
             (let ([p (foreign-call "ikrt_bnbndivrem" x y)])
               (values (car p) (cdr p)))]
-           [else (error 'quotient+remainder 
+           [(flonum? y) 
-                        "~s is not a number" y)])]
+            (let ([v ($flonum->exact y)])
-        [else (error 'quotient+remainder 
+              (cond
-                  "~s is not a number" x)])))
+                [(or (fixnum? v) (bignum? v)) 
+                 (let-values ([(q r) (quotient+remainder x v)])
+                   (values (inexact q) (inexact r)))]
+                [else
+                 (error 'quotient+remainder "~s is not an integer" y)]))] 
+           [else (error 'quotient+remainder "~s is not a number" y)])]
+        [(flonum? x) 
+         (let ([v ($flonum->exact x)])
+           (cond
+             [(or (fixnum? v) (bignum? v)) 
+              (let-values ([(q r) (quotient+remainder v y)])
+                (values (inexact q) (inexact r)))]
+             [else (error 'quotient+remainder "~s is not an integer" x)]))]
+        [else (error 'quotient+remainder "~s is not a number" x)])))
 
   (define positive?
     (lambda (x)
@@ -1796,6 +1816,7 @@
       (cond
         [(ratnum? x) ($ratnum-n x)]
         [(or (fixnum? x) (bignum? x)) x]
+        [(flonum? x) (flnumerator x)]
         [else (error 'numerator "~s is not an exact integer" x)])))
 
   (define denominator
@@ -1803,6 +1824,7 @@
       (cond
         [(ratnum? x) ($ratnum-d x)]
         [(or (fixnum? x) (bignum? x)) 1]
+        [(flonum? x) (fldenominator x)]
         [else (error 'denominator "~s is not an exact integer" x)])))
 
 

src/rationalize.ss

@@ -0,0 +1,44 @@
+#!/usr/bin/env ikarus --r6rs-script
+(import (ikarus))
+
+
+
+(define (rationalize x eps) 
+  (simplest (- x eps) (+ x eps)))
+
+
+(define (simplest x y) 
+  (cond
+    [(< y x) (simplest y x)]
+    [(= x y) x]
+    [(> x 0)
+     (let ([n (numerator x)] [d (denominator x)]
+           [n^ (numerator y)] [d^ (denominator y)])
+       (simplest^ n d n^ d^))]
+    [(< y 0) 
+     (let ([n (numerator x)] [d (denominator x)]
+           [n^ (numerator y)] [d^ (denominator y)])
+       (- (simplest^ (- n^) d^ (- n) d)))]
+    [else 1]))
+
+(define (simplest^ n d n^ d^)
+  (let-values ([(q r) (quotient+remainder n d)])
+    (if (= r 0) 
+        q
+        (let-values ([(q^ r^) (quotient+remainder n^ d^)])
+          (if (= q q^) 
+              (let ([v (simplest^ d^ r^ d r)])
+                (let ([n^^ (numerator v)] [d^^ (denominator v)])
+                  (/ (+ (* q n^^) d^^) n^^)))
+              (+ q 1))))))
+
+(define (test v0 v1 r) 
+  (let ([s (rationalize v0 v1)])
+    (unless (= s r) 
+      (error 'test "failed in ~s ~s => ~s, should be ~s" 
+             v0 v1 s r))))
+
+(test 314/100 1/100 22/7)
+(test (exact 0.3) 1/10 1/3)
+(test 0.3 1/10 #i1/3) 
+