conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* fixed a bug in fldenominator 

* added a file rationalize.ss that has the seed for the rationalize
  function
This commit is contained in:
Abdulaziz Ghuloum 2007-09-11 02:06:26 -04:00
parent e8f05ac4b7
commit bf28274d44
3 changed files with 73 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

36
src/ikarus.numerics.ss
View File

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

44
src/rationalize.ss Executable file
View File

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