(defpackage :rational-to-string
  (:use :cl)
  (:export #:rational-to-string
           #:string-to-rational))

(in-package :rational-to-string)

(defun rational-to-string (n precision &key (trim t))
  "Convert the rational number N to a string holding the decimal
representation of N having PRECISION digits after the decimal point.
If N is identically zero, \"0\" is returned.  If TRIM is true,
trailing zeros in the fractional part will be trimmed."

  ;;
  ;; The point of this function is to get around a limitation in
  ;; either my knowledge of lisp or lisp itself.  I cannot find a
  ;; (format) specificiation that will print a _rational_ with an
  ;; arbitrary amount of precision.  Instead, (format) always prints a
  ;; rational in the form "numerator/denominator".
  ;;
  ;; On the other hand, it is trivial to print an _integer_ with an
  ;; arbitrary amount of precision.  So the algorithm below basically
  ;; shifts "precision" worth of digits from the rational number
  ;; across to the left side of the decimal point.  It then uses
  ;; (round) to round off to an integer.  It then inserts a decimal
  ;; point into the correct location of the resulting string.
  ;;

  (declare (type rational n))

  (labels

       ;; (add-zeros) -- Add leading zero to the scaled value.  This
       ;; is needed so that, when numbers like 0.001 are scaled (by
       ;; multiplying below by (expt 10 precision)), the significant
       ;; zeros just to the right of the decimal place are not lost.
      ((add-zeros (s precision)
         (labels
             ;; Prepend "n" zero characters to acc and return as a string.
             ((make-zeros (n acc)
                (cond ((<= n 0) (coerce acc 'string))
                      (t (make-zeros (- n 1) (cons #\0 acc))))))
           (let ((slen (length s)))
             (cond ((< slen precision)
                    (concatenate 'string
                                 (make-zeros (- precision slen) '())
                                 s))
                    (t s)))))

      ;; (trim-zeros) -- Removes trailing zeros from the fractional
      ;; part.  This is for presentation purposes and is controlled
      ;; via the :trim keyword parameter.
      (trim-zeros (s precision)
        (cond ((null s) "0")
              ((eql #\0 (car s)) (trim-zeros (cdr s) precision))
              ((eql #\. (car s)) (coerce (reverse (cdr s)) 'string))
              (t (coerce (reverse s) 'string))))

       ;; (insert-decimal-point)
       (insert-decimal-point (s precision)
         (let ((pivot (- (length s) precision )))
           (when (< pivot 0) (error "Internal error.  Pivot too small."))
           (concatenate 'string
                        (if (= pivot 0) "0" (subseq s 0 pivot))
                        (if (= precision 0)
                            ""
                            (concatenate 'string "." (subseq s pivot)))))))

    (when (minusp precision)
      (error "precision cannot be negative"))

    (let* ((result-is-negative (< n 0))
           (x (* (abs n) (expt 10 precision)))
           (s (princ-to-string (round x)))
           (s (add-zeros s precision))
           (s (insert-decimal-point s precision))
           (rv (cond (trim (let ((s (coerce s 'list)))
                             (trim-zeros (reverse s) precision)))
                     (t s))))
      (if result-is-negative (concatenate 'string "-" rv) rv))))

(defun string-to-rational (s)
  "Convert the string S to a rational number and return the result.
S should be in the same format as output by (rational-to-string).
Obviously, a round-trip conversion is likely to lose precision, but
this function should be able to recover as much precision as is
available.  If you need to maintain precision, the rational number
probably shouldn't be converted to a decimal in the first place."

  (declare (type string s))

  (let* ((s1 (string-trim '(#\space #\tab #\return #\newline) s))
         (slen1 (length s1))
         (result-is-negative (find #\- s1)))

    ;; Sanity check.
    (when (zerop slen1)
      (error "Invalid format."))

    ;; Extract the whole-part of the fraction by using (parse-integer)
    ;; which stops at the decimal point because it thinks the decimal
    ;; point is junk.
    (multiple-value-bind (whole-part index1)
        (parse-integer s1 :junk-allowed t)

      ;; Make sure the previous call to (parse-integer) stopped at a
      ;; decimal or at the end of the string.
      (when (and (< index1 slen1)
                 (not (eql (elt s1 index1) #\.)))
        (error "Invalid format."))

      ;; Return the whole-part if s does not have a fractional part.
      (cond ((>= index1 slen1)
             (when (not whole-part)
               (error "Invalid format."))
             whole-part)

            ;; Otherwise, handle the fractional part.
            (t

             ;; Extract the fractional part using (parse-integer) again.
             (let* ((s2 (subseq s1 (+ index1 1)))
                    (slen2 (length s2)))

               ;; Make sure s2 does not contain a negative sign.
               (when (find #\- s2)
                 (error "Invalid format."))

               ;; Process the fractional part.
               (multiple-value-bind (fract-part index2)
                   (parse-integer s2 :junk-allowed t)
                 (when (< index2 slen2)
                   (error "Invalid format."))
                 (when (and (not whole-part)
                            (not fract-part))
                   (error "Invalid format."))

                 ;; Handle numbers like ".1" (with no whole-part) and
                 ;; numbers like "1." (with no fract-part).
                 (let ((whole-part2 (if whole-part whole-part 0))
                       (fract-part2 (if fract-part fract-part 0)))

                   ;; Return the parts as a rational number.
                   (let ((rv (+ (abs whole-part2)
                                (/ fract-part2
                                   (expt 10 index2)))))
                     (if result-is-negative
                         (- rv)
                         rv))))))))))