[plt-scheme] Printing

This is a part of my collects, with contracts and friends, used in a  
quotster and stock evaluation program. I have meant to put such  
"contracted" code up at Planet for a while, but time just disappears.  
-- Matthias


(module decimals mzscheme

   (require
    (lib "string.ss" "srfi" "13")
    (lib "contract.ss"))

   ;; Number Natural -> String -> Boolean
   ;; is the decimal point at the right place in the string
   (define (post-number->format-decimal _ n)
     (define (formatted-number-as-string str)
       (and (string? str)
            (char=? (string-ref str (- (string-length str) n 1) #\.))))
     formatted-number-as-string)

   ;; Any -> Boolean
   (define (real-or-rational x)
     (or (inexact? x) (integer? x) (real? x)))

   (provide/contract

    [number->format-decimal
     ;; convert a number into a formatted decimal string
     ;; given: 10.321 wanted: "10.32"
     ((flat-named-contract 'real-or-rational real-or-rational)
      natural-number/c
      . ->d .
      post-number->format-decimal)]

    [number->decimal-string
     ;; convert a number into a decimal string
     (number? . -> . string?)])

   ;; Number N -> String
   ;; turn the number x into a string with num digits after the decimal  
point
   (define (number->format-decimal x num)
     (let ([split (regexp-match "([0-9]*)\\.([0-9]*)"  
(number->decimal-string x))])
       (format "~a.~a" (cadr split) (string-pad-right (caddr split) num  
#\0))))

   ;  
------------------------------------------------------------------------ 
---
   ; Number -> String
   ; turns a number into a string with decimal representation
   ; Matthew's code
   (define (number->decimal-string x)
     (cond
       [(or (inexact? x) (integer? x)) (number->string x)]
       [(not (real? x)) ;; complex
        (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)])
          ;; Count powers of 2 in denomintor
          (let loop ([v d][2-power 0])
            (if (and (positive? v) (even? v))
                (loop (arithmetic-shift v -1) (add1 2-power))
                ;; Count powers of 5 in denominator
                (let loop ([v v][5-power 0])
                  (if (zero? (remainder v 5))
                      (loop (quotient v 5) (add1 5-power))
                      ;; No more 2s or 5s. Anything left?
                      (if (= v 1)
                          ;; Denominator = (* (expt 2 2-power) (expt 5  
5-power)).
                          ;; Print number as decimal.
                          (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)))
                          ;; d has factor(s) other than 2 and 5.
                          ;; Print as a fraction.
                          (number->string x)))))))])))