home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / xl21hos2.zip / RATIONAL.LSP < prev    next >
Lisp/Scheme  |  1995-12-27  |  916b  |  24 lines
  1. (in-package :xlisp)
  2. (export 'rationalize)
  3. (defun rationalize (val)    ; hopefully readable conversion
  4.        (unless (typep val 'flonum)
  5.            (if (typep val 'rational)
  6.            (return-from rationalize val)
  7.            (error "~s is invalid type" val)))
  8.        (let ((fraction (abs (rem val 1.0))))
  9.         (if (zerop fraction) 
  10.         (round val)
  11.         (let ((limit (expt 10 (- (+ 7 (truncate (log fraction 10)))
  12.                       (max 0 (truncate (log (abs val) 10))))))
  13.               divisor)
  14.              (cond ((>= limit 10000)    ; allow primes 3 3 7 11 13
  15.                 (setq limit (* 9009 (/ limit 10000))))
  16.                ((>= limit 1000)    ; allow primes 3 3 7 11
  17.                 (setq limit (* 693 (/ limit 1000))))
  18.                ((>= limit 100)    ; allow primes 3 3 7
  19.                 (setq limit (* 63 (/ limit 100)))))
  20.              (setq divisor (round (/ limit fraction)))
  21.               (if (floatp divisor) 
  22.               (round val)    ; Doesn't fit
  23.               (/ (round (* val divisor)) divisor))))))
  24.