Programming Praxis

We wrote a function to convert numbers to cardinal words a long time ago, and repeat it here:

(define (num->words n)
  (letrec ((ones '("" "one" "two" "three" "four" "five" "six"
             "seven" "eight" "nine" "ten" "eleven" "twelve"
             "thirteen" "fourteen" "fifteen" "sixteen"
             "seventeen" "eighteen" "nineteen"))
           (tens '("" "" "twenty" "thirty" "forty" "fifty"
             "sixty" "seventy" "eighty" "ninety"))
           (groups '("" "thousand" "million" "billion" "trillion"
             "quadrillion" "quintillion" "sextillion"
             "septillion" "octillion" "nonillion" "decillion"
             "undecillion" "duodecillion" "tredecillion"
             "quattuordecillion" "quindecillion" "sexdecillion"
             "septendecillion" "octodecillion" "novemdecillion"
             "vigintillion"))
           (nnn->words (lambda (n) ; three-digit numbers
             (cond ((<= 100 n)
                     (string-append
                       (list-ref ones (quotient n 100))
                       " hundred"
                       (if (positive? (modulo n 100)) " " "")
                       (nnn->words (modulo n 100))))
                   ((<= 20 n)
                     (string-append
                       (list-ref tens (quotient n 10))
                       (if (zero? (modulo n 10)) ""
                         (string-append "-" (list-ref ones (modulo n 10))))))
                   (else (list-ref ones n))))))
    (cond ((negative? n) (string-append "negative " (num->words (- n))))
          ((<= #e1e66 n) (error 'num->words "out of range"))
          ((zero? n) "zero")
          ((< n 1000) (nnn->words n))
          (else (let loop ((n n) (groups groups))
                  (let ((prev (quotient n 1000))
                        (group (modulo n 1000)))
                    (string-append
                      (if (zero? prev) ""
                        (loop prev (cdr groups)))
                      (if (zero? group) ""
                        (string-append
                          (if (positive? prev) " " "")
                          (nnn->words group)
                          (if (string=? "" (car groups)) ""
                            (string-append " " (car groups))))))))))))

Given that, it is easy to write the ordinals, because only the last element of the number changes, and in a systematic way: most numbers just add “th”, numbers that end in “y” (twenty, thirty, …) change the “y” to “ie” before adding the “th”, and there are a few oddballs that don’t follow the rules: 1, 2, 3, 5, 8, 9 and 12:

(define (ordinal n)
  (let* ((oddballs '(("one" . "first")
            ("two" . "second") ("three" . "third")
            ("five" . "fifth") ("eight" . "eighth")
            ("nine" . "ninth") ("twelve" . "twelfth")))
         (cardinal (num->words n))
         (last-element (list->string (reverse (take-while
           char-alphabetic? (reverse (string->list cardinal))))))
         (beginning (substring cardinal 0
           (- (string-length cardinal) (string-length last-element)))))
    (cond ((assoc last-element oddballs) =>
            (lambda (x) (string-append beginning (cdr x))))
          ((char=? #\y (string-ref last-element
                   (- (string-length last-element) 1)))
            (string-append beginning (substring last-element 0
                (- (string-length last-element) 1)) "ieth"))
          (else (string-append cardinal "th")))))

And here is a quick test from Rosetta Code:

(for-each (lambda (n) (display n) (display #\tab)
                      (display (num->words n)) (display #\tab)
                      (display (ordinal n)) (newline))
          '(1 2 3 4 5 11 65 100 101 277 23456 8007006005004003))

You can see the program at https://ideone.com/PX4x43, but it doesn’t work because … Chicken.

Pages: 1 2