/prog/ - Continued Fractions

Name: Anonymous 2007-09-03 14:57 ID:Yg9/l8CK

(defun continued-fraction (real)

  (multiple-value-bind (integer-part fractional-part)

      (floor (rationalize real))

    (cons integer-part (if (zerop fractional-part)

               nil

               (continued-fraction (/ 1 fractional-part))))))

What does /prog/ think? Am I shooting myself in the foot by just throwing rationalize in there and hoping it works out?

Name: Anonymous 2007-09-04 2:12 ID:Yf1b6cem

>>34
Okay, if you want it. Here's updated code that copes with floating point bullshit by sidestepping it entirely.



(defun continued-fraction (real)

  (when (stringp real) (return-from continued-fraction

             (continued-fraction (read-as-rational real))))

  (when (floatp real) (return-from continued-fraction

            (continued-fraction (read-as-rational (write-to-string real)))))

  (multiple-value-bind (integer-part fractional-part)

      (floor real)

    (cons integer-part (unless (zerop fractional-part)

             (continued-fraction (/ fractional-part))))))



(defun read-as-rational (string)

  (let* ((read-value (read-from-string string)))

    (cond ((not (numberp read-value)) (error "Attempted to treat input string as number: failed."))

      ((rationalp read-value) (return-from read-as-rational read-value)) ;; No foul.

      ((floatp read-value) 

       (let* ((bare-number (replace-all string "d0" ""))

          (clean-string (replace-all bare-number "." ""))

          (number-length (length clean-string))

          (radix-pos (- number-length

                (position #\. bare-number :from-end nil)))

          (divisor (expt 10  radix-pos)))

         (/ (read-from-string clean-string)

        divisor))))))

  

;;; Found replace-all on http://cl-cookbook.sourceforge.net/strings.html

(defun replace-all (string part replacement &key (test #'char=))

"Returns a new string in which all the occurences of the part 

is replaced with replacement."

    (with-output-to-string (out)

      (loop with part-length = (length part)

            for old-pos = 0 then (+ pos part-length)

            for pos = (search part string

                              :start2 old-pos

                              :test test)

            do (write-string string out

                             :start old-pos

                             :end (or pos (length string)))

            when pos do (write-string replacement out)

            while pos)))

Continued Fractions

1 Name: Anonymous 2007-09-03 14:57 ID:Yg9/l8CK

35 Name: Anonymous 2007-09-04 2:12 ID:Yf1b6cem

Name: Anonymous 2007-09-03 14:57 ID:Yg9/l8CK

Name: Anonymous 2007-09-04 2:12 ID:Yf1b6cem