lize.scm 1.0 KB

123456789101112131415161718192021222324252627282930313233343536
  1. ; Copyright (c) 1993-2008 by Richard Kelsey and Jonathan Rees. See file COPYING.
  2. ; Simplest rational within an interval. Copied from IEEE P1178/D4 nimpl.tex.
  3. (define (rationalize x e)
  4. (let ((e (abs e)))
  5. (simplest-rational (- x e) (+ x e))))
  6. (define (simplest-rational x y)
  7. (define (simplest-rational-internal x y)
  8. ;; assumes 0 < X < Y
  9. (let ((fx (floor x))
  10. (fy (floor y)))
  11. (cond ((not (< fx x))
  12. fx)
  13. ((= fx fy)
  14. (+ fx
  15. (/ 1 (simplest-rational-internal
  16. (/ 1 (- y fy))
  17. (/ 1 (- x fx))))))
  18. (else
  19. (+ 1 fx)))))
  20. ;; Do some juggling to satisfy preconditions of simplest-rational-internal.
  21. (cond ((not (< x y))
  22. (if (rational? x) x (error "(rationalize <irrational> 0)" x)))
  23. ((positive? x)
  24. (simplest-rational-internal x y))
  25. ((negative? y)
  26. (- 0 (simplest-rational-internal (- 0 y) (- 0 x))))
  27. (else
  28. (if (and (exact? x) (exact? y))
  29. 0
  30. (exact->inexact 0)))))