(module decimals mzscheme
(require
(lib "string.ss" "srfi" "13")
(lib "contract.ss"))
(provide/contract
[number->decimal-string
(number? . -> . any)]
[number->format-decimal
((flat-named-contract "<Real or Rational>"
(lambda (x)
(or (inexact? x) (integer? x) (real? x))))
natural-number/c
. ->d .
(lambda (_ n) (lambda (str)
(and (string? str)
(char=? (string-ref str (- (string-length str) n 1)) #\.)))))]
[integer->format-decimal
(integer?
natural-number/c
. ->d .
(lambda (_ n) (lambda (str)
(and (string? str)
(char=? (string-ref str (- (string-length str) n 1)) #\.)))))])
(define (number->format-decimal x num)
(if (integer? x)
(integer->format-decimal x num)
(let* ([str (number->decimal-string x)]
[split (regexp-match "([0-9]*)\\.([0-9]*)" str)])
(cond
((pair? split)
(format "~a.~a" (cadr split)
(string-pad-right (caddr split) num #\0)))
(else
(error 'number->format-decimal
"whoops, can't handle this: ~a -> ~a"
x split))))))
(define (integer->format-decimal n num)
(format "~a.~a" n (make-string (inexact->exact num) #\0)))
(define (number->decimal-string x)
(cond
[(or (inexact? x) (integer? x)) (number->string x)]
[(not (real? x)) (let ([r (real-part x)]
[i (imag-part x)])
(format "~a~a~ai"
(number->decimal-string r)
(if (negative? i) "" "+")
(number->decimal-string i)))]
[else
(let ([n (numerator x)]
[d (denominator x)])
(let loop ([v d][2-power 0])
(if (and (positive? v) (even? v))
(loop (arithmetic-shift v -1) (add1 2-power))
(let loop ([v v][5-power 0])
(if (zero? (remainder v 5))
(loop (quotient v 5) (add1 5-power))
(if (= v 1)
(let* ([10-power (max 2-power 5-power)]
[scale (* (expt 2 (- 10-power 2-power))
(expt 5 (- 10-power 5-power)))]
[s (number->string (* (abs n) scale))]
[orig-len (string-length s)]
[len (max (add1 10-power) orig-len)]
[padded-s (if (< orig-len len)
(string-append
(make-string (- len orig-len) #\0)
s)
s)])
(format "~a~a.~a"
(if (negative? n) "-" "")
(substring padded-s 0 (- len 10-power))
(substring padded-s (- len 10-power) len)))
(number->string x)))))))])))