codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; oban words (define-syntax fold-of (syntax-rules (range in is) ((_ "z" f b e) (set! b (f b e))) ((_ "z" f b e (v range fst pst stp) c ...) (let* ((x fst) (p pst) (s stp) (le? (if (positive? s) <= >=))) (do ((v x (+ v s))) ((le? p v) b) (fold-of "z" f b e c ...)))) ((_ "z" f b e (v range fst pst) c ...) (let* ((x fst) (p pst) (s (if (< x p) 1 -1))) (fold-of "z" f b e (v range x p s) c ...))) ((_ "z" f b e (v range pst) c ...) (fold-of "z" f b e (v range 0 pst) c ...)) ((_ "z" f b e (x in xs) c ...) (do ((t xs (cdr t))) ((null? t) b) (let ((x (car t))) (fold-of "z" f b e c ...)))) ((_ "z" f b e (x is y) c ...) (let ((x y)) (fold-of "z" f b e c ...))) ((_ "z" f b e p? c ...) (if p? (fold-of "z" f b e c ...))) ((_ f i e c ...) (let ((b i)) (fold-of "z" f b e c ...))))) (define-syntax list-of (syntax-rules () ((_ arg ...) (reverse (fold-of (lambda (d a) (cons a d)) '() arg ...))))) (define (string-index c str) (let loop ((ss (string->list str)) (k 0)) (cond ((null? ss) #f) ((char=? (car ss) c) k) (else (loop (cdr ss) (+ k 1)))))) (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 " (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)))))))))))) (for-each (lambda (n) (display n) (newline)) (list-of n (n range 1000) (not (string-index #\o (num->words n)))))
Private
[
?
]
Run code
Submit