Initial commit, 3-52-19 alpha
[cls.git] / xlisponly / lsp / rational.lsp
blob759790d53b22ea8fe9801a42510812b40f373e2e
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))))))