[CM] cmn's iratify
andersvi@extern.uio.no
andersvi@extern.uio.no
Wed, 18 Jan 2006 13:14:56 +0100
cmns #'iratify is giving me some strange results here (first
thought it was some roundoff error, but it seems theres something
with the algorithm behind). The behavior is consistent across
lisps.
CMN> (iratify 0.125)
1/8
CMN> (iratify (* 8 0.125))
1
CMN> (iratify (* 9 0.125))
10/9
i would expect the last one to return 9/8.
Does anybody see whats wrong here?
heres the relevant section from cmn/cmn-utils.lisp
(defvar smallest-note .015625) ;256-th note (1/64)
(defun ratify-1 (ux)
(if (zerop ux) (list 0 1)
(let ((tt 1)
(err smallest-note)
(a1 0)
(b2 0)
(a2 1)
(b1 1)
(a 0)
(b 0)
(x (/ 1.0 ux)))
(loop while t do
(setf a (+ (* a1 tt) a2))
(setf b (+ (* tt b1) b2))
(if (and (/= b 0) (or (> b 100) (<= (abs (- ux (/ a b))) err)))
(return-from ratify-1 (list a b)))
(if (< b -100) (return-from ratify-1 (list (- a) (- b))))
(setf x (/ 1 (- x tt)))
(setf tt (floor x))
(setf a2 a1)
(setf b2 b1)
(setf a1 a)
(setf b1 b)
))))
(defun ratify (num) ;rational returns gigantic useless factors
(if (floatp num)
(if (<= num 16.0)
(ratify-1 num)
(multiple-value-bind (int frac) (floor num)
(if (= frac 0.0)
(list int 1)
(let ((vals (ratify-1 frac)))
(list (+ (* int (second vals)) (first vals)) (second vals))))))
(if (ratiop num)
(list (numerator num) (denominator num))
(list num 1))))
(defun fratify (num)
(if (floatp num)
(apply #'/ (ratify num))
num))
(defun iratify (num) (coerce (apply #'/ (ratify num)) 'rational))