1 ! Copyright (c) 2007, 2008 Aaron Schaefer.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators.short-circuit grouping kernel math math.parser namespaces
9 : small-numbers ( n -- str )
10 { "Zero" "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine"
11 "Ten" "Eleven" "Twelve" "Thirteen" "Fourteen" "Fifteen" "Sixteen"
12 "Seventeen" "Eighteen" "Nineteen" } nth ;
15 { f f "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ;
17 : scale-numbers ( n -- str ) ! up to 10^99
18 { f "Thousand" "Million" "Billion" "Trillion" "Quadrillion" "Quintillion"
19 "Sextillion" "Septillion" "Octillion" "Nonillion" "Decillion" "Undecillion"
20 "Duodecillion" "Tredecillion" "Quattuordecillion" "Quindecillion"
21 "Sexdecillion" "Septendecillion" "Octodecillion" "Novemdecillion"
22 "Vigintillion" "Unvigintillion" "Duovigintillion" "Trevigintillion"
23 "Quattuorvigintillion" "Quinvigintillion" "Sexvigintillion"
24 "Septvigintillion" "Octovigintillion" "Novemvigintillion" "Trigintillion"
25 "Untrigintillion" "Duotrigintillion" } nth ;
28 : set-conjunction ( seq -- )
29 first { [ 100 < ] [ 0 > ] } 1&& and-needed? set ;
31 : negative-text ( n -- str )
32 0 < "Negative " "" ? ;
34 : 3digit-groups ( n -- seq )
35 [ dup 0 > ] [ 1000 /mod ] [ ] produce nip ;
37 : hundreds-place ( n -- str )
41 [ small-numbers " Hundred" append ] dip
42 0 = [ " and " append ] unless
45 : tens-place ( n -- str )
48 dup 0 = [ drop ] [ small-numbers "-" glue ] if
50 dup 0 = [ drop "" ] [ small-numbers ] if
53 : 3digits>text ( n -- str )
54 [ hundreds-place ] [ tens-place ] bi append ;
56 : text-with-scale ( index seq -- str )
57 [ nth 3digits>text ] [ drop scale-numbers ] 2bi
58 [ " " glue ] unless-empty ;
60 : append-with-conjunction ( str1 str2 -- newstr )
64 swap and-needed? get " and " ", " ?
68 : (recombine) ( str index seq -- newstr )
72 text-with-scale append-with-conjunction
75 : recombine ( seq -- str )
79 [ set-conjunction "" ] [ length ] [ ] tri
80 [ (recombine) ] curry each
83 : (number>text) ( n -- str )
84 [ negative-text ] [ abs 3digit-groups recombine ] bi append ;
88 : number>text ( n -- str )
89 dup zero? [ small-numbers ] [ [ (number>text) ] with-scope ] if ;