fork download
copy 
  1. ; cardinal and ordinal numbers
  2.  
  3. (define (take-while pred? xs)
  4.   (let loop ((xs xs) (ys '()))
  5.     (if (or (null? xs) (not (pred? (car xs))))
  6.         (reverse ys)
  7.         (loop (cdr xs) (cons (car xs) ys)))))
  8.  
  9. (define (num->words n)
  10.   (letrec ((ones '("" "one" "two" "three" "four" "five" "six"
  11.              "seven" "eight" "nine" "ten" "eleven" "twelve"
  12.              "thirteen" "fourteen" "fifteen" "sixteen"
  13.              "seventeen" "eighteen" "nineteen"))
  14.            (tens '("" "" "twenty" "thirty" "forty" "fifty"
  15.              "sixty" "seventy" "eighty" "ninety"))
  16.            (groups '("" "thousand" "million" "billion" "trillion"
  17.              "quadrillion" "quintillion" "sextillion"
  18.              "septillion" "octillion" "nonillion" "decillion"
  19.              "undecillion" "duodecillion" "tredecillion"
  20.              "quattuordecillion" "quindecillion" "sexdecillion"
  21.              "septendecillion" "octodecillion" "novemdecillion"
  22.              "vigintillion"))
  23.            (nnn->words (lambda (n) ; three-digit numbers
  24.              (cond ((<= 100 n)
  25.                      (string-append
  26.                        (list-ref ones (quotient n 100))
  27.                        " hundred"
  28.                        (if (positive? (modulo n 100)) " " "")
  29.                        (nnn->words (modulo n 100))))
  30.                    ((<= 20 n)
  31.                      (string-append
  32.                        (list-ref tens (quotient n 10))
  33.                        (if (zero? (modulo n 10)) ""
  34.                          (string-append "-" (list-ref ones (modulo n 10))))))
  35.                    (else (list-ref ones n))))))
  36.     (cond ((negative? n) (string-append "negative " (num->words (- n))))
  37.           ((<= #e1e66 n) (error 'num->words "out of range"))
  38.           ((zero? n) "zero")
  39.           ((< n 1000) (nnn->words n))
  40.           (else (let loop ((n n) (groups groups))
  41.                   (let ((prev (quotient n 1000))
  42.                         (group (modulo n 1000)))
  43.                     (string-append
  44.                       (if (zero? prev) ""
  45.                         (loop prev (cdr groups)))
  46.                       (if (zero? group) ""
  47.                         (string-append
  48.                           (if (positive? prev) " " "")
  49.                           (nnn->words group)
  50.                           (if (string=? "" (car groups)) ""
  51.                             (string-append " " (car groups))))))))))))
  52.  
  53. (define (ordinal n)
  54.   (let* ((oddballs '(("one" . "first")
  55.             ("two" . "second") ("three" . "third")
  56.             ("five" . "fifth") ("eight" . "eighth")
  57.             ("nine" . "ninth") ("twelve" . "twelfth")))
  58.          (cardinal (num->words n))
  59.          (last-element (list->string (reverse (take-while
  60.            char-alphabetic? (reverse (string->list cardinal))))))
  61.          (beginning (substring cardinal 0
  62.            (- (string-length cardinal) (string-length last-element)))))
  63.     (cond ((assoc last-element oddballs) =>
  64.             (lambda (x) (string-append beginning (cdr x))))
  65.           ((char=? #\y (string-ref last-element
  66.                    (- (string-length last-element) 1)))
  67.             (string-append beginning (substring last-element 0
  68.                 (- (string-length last-element) 1)) "ieth"))
  69.           (else (string-append cardinal "th")))))
  70.  
  71. (for-each (lambda (n) (display n) (display #\tab)
  72.                       (display (num->words n)) (display #\tab)
  73.                       (display (ordinal n)) (newline))
  74.           '(1 2 3 4 5 11 65 100 101 277 23456 8007006005004003))
Runtime error #stdin #stdout #stderr 0.01s 7548KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
Error: (inexact->exact) inexact number cannot be represented as an exact number: 1e+66

	Call history:

	<syntax>	  [take-while] (##core#if tmp6 tmp6 (or7 (not (pred? (car xs)))))
	<syntax>	  [take-while] (or7 (not (pred? (car xs))))
	<syntax>	  [take-while] (not (pred? (car xs)))
	<syntax>	  [take-while] (pred? (car xs))
	<syntax>	  [take-while] (car xs)
	<syntax>	  [take-while] (null? xs)
	<syntax>	  [take-while] (reverse ys)
	<syntax>	  [take-while] (loop (cdr xs) (cons (car xs) ys))
	<syntax>	  [take-while] (cdr xs)
	<syntax>	  [take-while] (cons (car xs) ys)
	<syntax>	  [take-while] (car xs)
	<syntax>	  [take-while] (##core#let () loop)
	<syntax>	  [take-while] (##core#begin loop)
	<syntax>	  [take-while] (##core#undefined)
	<syntax>	  [take-while] (quote ())
	<syntax>	  [take-while] (##core#quote ())	<--
https://ideone.com/PX4x43
language:
Scheme (chicken 4.13)
created:
2 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!