Formatted Numeric Output

May 18, 2012

We provide functions similar to C: (number->decimal num wid align) outputs integers and (number->float num wid prec align) outputs floats, where the output action is to return the formatted string, which can passed on to display or concatenated to other strings with string-append or processed in other ways as needed. Num is the number to output. Wid is the number of print positions to output. Prec is the number of digits after the decimal point. Align is 'left if the output is to be left-aligned in the output string, 'right if the output is to be right-aligned in the output string, and 'center if the output is to be centered in the output string; the align parameter is optional, and defaults to 'right if not specified. If the number is too big to fit in the specified wid, the output string consists of wid hash characters “#“. We won’t use Scheme’s number->string function, which would be cheating.

We begin with the code to align the output. Align takes a string, a width, and an alignment specification and returns a string with the input properly aligned; it also handles the case that the output is too big:

(define (align str wid aline)
  (let ((len (string-length str)))
    (cond ((< wid len) (rept wid #\#))
          ((eq? aline'left) (string-append str (rept (- wid len))))
          ((eq? aline 'center)
           (let* ((left (quotient (- wid len) 2)) (right (- wid len left)))
             (string-append (rept left) str (rept right))))
          ((eq? aline 'right) (string-append (rept (- wid len)) str))
          (else (error 'align "invalid alignment specifier")))))

To format integers, we split the sign from the number and handle each separately. Note the special treatment for an input of 0, which causes the digits function to return an empty list:

(define (number->decimal num wid . aline)
  (if (not (integer? num))
      (error 'number->decimal "invalid input")
      (let ((aline (if (pair? aline) (car aline) 'right))
             (sign (if (negative? num) "-" (if (zero? num) "0" "")))
             (num (list->string (map digit->char (digits (abs num))))))
        (align (string-append sign num) wid aline))))

Formatting decimal numbers is harder. Here, we split the number into three parts — sign, integer part, fractional part — and carefully deal with 0:

(define (number->float num wid prec . aline)
  (if (not (number? num))
      (error 'number->float "invalid input")
      (let* ((aline (if (pair? aline) (car aline) 'right))
             (sign (if (negative? num) "-" (if (zero? num) "0" "")))
             (num (abs num))
             (left (inexact->exact (truncate num)))
             (right (inexact->exact (round (* (- num left) (expt 10 prec)))))
             (left (list->string (map digit->char (digits left))))
             (right (if (zero? right) (rept prec #\0)
                      (list->string (map digit->char (digits right))))))
        (align (string-append sign left "." right) wid aline))))

Here are some examples:

> (number->decimal 1234 12 'left)
"1234        "
> (number->decimal -1234 12 'right)
"       -1234"
> (number->decimal 0 12 'center)
"     0      "
> (number->float 1234.56 12 4 'left)
"1234.5600   "
> (number->float -1234.5678 12 2 'right)
"    -1234.57"
> (number->float 1234 12 2 'center)
"  1234.00   "
> (number->float 1234.56 12 4)
"   1234.5600"
> (number->float 0.1234 12 4)
"       .1234"
> (number->float 0 12 4)
"      0.0000"

We used digits from the Standard Prelude. You can run the program at, where you can also see the digit->char and rept functions.

Pages: 1 2

2 Responses to “Formatted Numeric Output”

  1. ardnew said

    This may not conform exactly with the proposed problem, but an interesting read regarding implementing printf for C++ programmers:

  2. David said

    I thought it would be fun to implement the Dartmouth BASIC printing format. This was back in the days where formatting didn’t seem all the necessary as the computer printed how users intuitively expected things to go. In FORTH since that language (a) has a standard word to pick apart a floating point number and (b) default printing is rather unfriendly in that language.

    { ---------------------------------------------------------------------------
    Rules for printing Dartmouth BASIC numbers  (except allowing more than 6
    digits of precision, given the modern era of 64 bit FP.)
    Let P = desired output precision:
    1. If a number is an integer, the decimal point is not printed.  If the
       integer contains more than P digits, display in scientific notation with
       P significant digits.
    2. For any decimal number, no more than P significant digits are printed.
    3. For a number less than 0.1, the E notation is used unless the entire
       significant part of the number can be printed as a P decimal number.
       Thus, 0.01234578 means the number is exactly 0.012345678, while
       1.2345678E-2 means that the number has been rounded to 0.012345678
    4. Trailing zeros after the decimal point are not printed.
     --------------------------------------------------------------------------- }
    requires fpmath
    create fp-repr  20 chars allot
    create zero-str ,z" 00000000000000000" \ used to compare zero strings
    : fp-integer?  ( exp -- )
        dup precision >=          \ exponent > precision => integer
        swap precision over -     \ length to compare
        swap fp-repr + swap       \ address to compare
        zero-str over compare 0=  \ compare to all zeros
        or ;
    : (adjust)   ( addr count -- addr count' )
        over + 1-   \ addr end-addr
        BEGIN  dup c@ [char] 0 = WHILE
        REPEAT  over - 1+ ;
    : .sci  ( exp -- )
        fp-repr c@ emit
        [char] . emit
        fp-repr 1+ precision 1- (adjust) type
        [char] E emit
        dup 0> IF  [char] + emit  THEN
        . ;
    : .fp-integer ( exp -- )
        dup precision <= IF
            fp-repr swap type space
            1- .sci
        THEN ;
    : .fp-small  ( exp -- )
        fp-repr precision + 1- c@  [char] 0 = IF
            ." 0."
            negate 0 DO  [char] 0 emit  LOOP
            fp-repr precision (adjust) type
            1- .sci
        THEN ;
    : .fp   ( exp -- )
        dup IF
            dup fp-repr swap type
            [char] 0 emit
        [char] . emit
        fp-repr over +  swap precision swap -  (adjust) type space ;
    : fp.   ( fp -- )
        fp-repr precision represent
        invert IF abort" Invalid FP value on stack." THEN
        ( sign ) IF  [char] - emit  THEN
        fp-repr c@ [char] 0 = IF   \ zero special case
            drop ." 0" exit
        dup fp-integer? IF
            .fp-integer exit
        dup 0<    \ <= 10^-1
            IF .fp-small exit
        ( ELSE ) .fp ;

    Some tests:

    0e fp. 0 ok
    2e fsqrt fp. 1.41421356237  ok
    944,221,771,433,788 d>f fp. 9.44221771434E+14  ok
    0.00875e fp. 0.00875 ok
    0.00877777777777777e fp. 8.77777777778E-3  ok
    -25.75e fp. -25.75  ok
    255e fp. 255  ok
    49e fsqrt fp. 7  ok
    0.530000e fp. 0.53  ok
    6 set-precision  ok
    676,211,477,636,211 d>f f. 676211000000000.  ok
    676,211,477,636,211 d>f fp. 6.76211E+14  ok

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

%d bloggers like this: