1 ! Copyright (c) 2007, 2008, 2018 Aaron Schaefer, 2022 Alexander Ilin.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: combinators combinators.short-circuit kernel math
4 math.order math.parser math.text.utils namespaces sequences
10 : small-numbers ( n -- str )
12 "zero" "one" "two" "three" "four" "five" "six"
13 "seven" "eight" "nine" "ten" "eleven" "twelve"
14 "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
20 f f "twenty" "thirty" "forty" "fifty" "sixty"
21 "seventy" "eighty" "ninety"
24 : scale-numbers ( n -- str ) ! up to 10^630
28 f "thousand" "million" "billion" "trillion" "quadrillion"
29 "quintillion" "sextillion" "septillion" "octillion"
30 "nonillion" "decillion" "undecillion" "duodecillion"
31 "tredecillion" "quattuordecillion" "quindecillion"
32 "sexdecillion" "septendecillion" "octodecillion"
33 "novemdecillion" "vigintillion" "unvigintillion"
34 "duovigintillion" "trevigintillion" "quattuorvigintillion"
35 "quinvigintillion" "sexvigintillion" "septvigintillion"
36 "octovigintillion" "novemvigintillion" "trigintillion"
37 "untrigintillion" "duotrigintillion" "trestrigintillion"
38 "quattuortrigintillion" "quintrigintillion" "sestrigintillion"
39 "septentrigintillion" "octotrigintillion" "noventrigintillion"
45 "quadragintillion" "quinquagintillion" "sexagintillion"
46 "septuagintillion" "octogintillion" "nonagintillion"
47 "centillion" "decicentillion" "viginticentillion"
48 "trigintacentillion" "quadragintacentillion"
49 "quinquagintacentillion" "sexagintacentillion"
50 "septuagintacentillion" "octogintacentillion"
51 "nonagintacentillion" "ducentillion"
53 ! Next 10^300 increments after ducentillion, which is 10^603:
54 ! "trecentillion" "quadringentillion"
55 ! "quingentillion" "sescentillion"
56 ! "septingentillion" "octingentillion"
57 ! "nongentillion" "millinillion" = 10^3003
60 f "un" "duo" "tre" "quattuor"
61 "quinqua" "se" "septe" "octo" "nove"
63 ] bi* swap "" append-as
68 : set-conjunction ( seq -- )
69 first { [ 100 < ] [ 0 > ] } 1&& and-needed? set ;
71 : negative-text ( n -- str )
72 0 < "negative " "" ? ;
74 : hundreds-place ( n -- str )
78 [ small-numbers " hundred" append ] dip
79 0 = [ " and " append ] unless
82 : tens-place ( n -- str )
85 [ small-numbers "-" glue ] unless-zero
87 [ "" ] [ small-numbers ] if-zero
90 : 3digits>text ( n -- str )
91 [ hundreds-place ] [ tens-place ] bi append ;
93 : text-with-scale ( index seq -- str )
94 [ nth 3digits>text ] [ drop scale-numbers ] 2bi
95 [ " " glue ] unless-empty ;
97 : append-with-conjunction ( str1 str2 -- newstr )
99 and-needed? get " and " ", " ? glue
103 : (recombine) ( str index seq -- newstr )
107 text-with-scale append-with-conjunction
110 : recombine ( seq -- str )
114 [ set-conjunction "" ] [ length ] [ ] tri
115 [ (recombine) ] curry each-integer
118 : (number>text) ( n -- str )
119 [ negative-text ] [ abs 3 digit-groups recombine ] bi append ;
123 GENERIC: number>text ( n -- str )
125 M: integer number>text
126 [ "zero" ] [ [ (number>text) ] with-scope ] if-zero ;
129 >fraction [ number>text ] bi@ " divided by " glue ;
132 number>string "." split1 [
134 [ string>number number>text ]
135 [ [ "negative " prepend ] when ] bi*
137 [ CHAR: 0 - small-numbers ] { } map-as join-words
138 ] bi* " point " glue ;
140 M: complex number>text
141 >rect [ number>text ] [
142 [ 0 < " minus " " plus " ? ]
143 [ abs number>text " i" append ] bi
146 : ordinal-suffix ( n -- suffix )
147 abs dup 100 mod 11 13 between? [ drop "th" ] [
156 : number-ap-style ( n -- str )
157 dup { [ integer? ] [ 0 9 between? ] } 1&&
158 [ number>text ] [ number>string ] if ;
160 : ordinal-ap-style ( n -- str )
162 f "first" "second" "third" "fourth" "fifth" "sixth"
163 "seventh" "eighth" "ninth"
165 [ number>string ] [ ordinal-suffix ] bi append