; cardinal and ordinal numbers
(define (take-while pred? xs)
(let loop ((xs xs) (ys '()))
(if (or (null? xs) (not (pred? (car xs))))
(reverse ys)
(loop (cdr xs) (cons (car xs) ys)))))
(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))))))))))))
(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")))))
(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))