diff --git a/src/ikarus.boot b/src/ikarus.boot index ca0e1d0..59e3283 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.numerics.ss b/src/ikarus.numerics.ss index b26e5e8..ead6a0e 100644 --- a/src/ikarus.numerics.ss +++ b/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 - "~s is not a number" y)])] + [(flonum? 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 - "~s is not a number" y)])] - [else (error 'quotient+remainder - "~s is not a number" x)]))) + [(flonum? 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)])] + [(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)]))) diff --git a/src/rationalize.ss b/src/rationalize.ss new file mode 100755 index 0000000..8930aa8 --- /dev/null +++ b/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) +