New math.text vocab converts numbers to English

extra/math/text/authors.txt

@@ -0,0 +1 @@
+Aaron Schaefer

extra/math/text/summary.txt

@@ -0,0 +1 @@
+Convert integers to text

extra/math/text/text-docs.factor

@@ -0,0 +1,7 @@
+USING: help.markup help.syntax math strings ;
+IN: math.text
+
+HELP: number>text
+{ $values { "n" integer } { "str" string } }
+{ $description "Converts an integer to a text string representation in English, including appropriate punctuation and conjunctions." }
+{ $examples { $example "12345 number>text ." "\"Twelve Thousand, Three Hundred and Forty-Five\"" } } ;

extra/math/text/text-tests.factor

@@ -0,0 +1,15 @@
+USING: math.functions math.text tools.test ;
+IN: temporary
+
+[ "Zero" ] [ 0 number>text ] unit-test
+[ "Twenty-One" ] [ 21 number>text ] unit-test
+[ "One Hundred" ] [ 100 number>text ] unit-test
+[ "One Hundred and One" ] [ 101 number>text ] unit-test
+[ "One Thousand and One" ] [ 1001 number>text ] unit-test
+[ "One Thousand, One Hundred and One" ] [ 1101 number>text ] unit-test
+[ "One Million, One Thousand and One" ] [ 1001001 number>text ] unit-test
+[ "One Million, One Thousand, One Hundred and One" ] [ 1001101 number>text ] unit-test
+[ "One Million, One Hundred and Eleven Thousand, One Hundred and Eleven" ] [ 1111111 number>text ] unit-test
+[ "One Duotrigintillion" ] [ 10 99 ^ number>text ] unit-test
+
+[ "Negative One Hundred and Twenty-Three" ] [ -123 number>text ] unit-test

extra/math/text/text.factor

@@ -0,0 +1,103 @@
+! Copyright (c) 2007 Aaron Schaefer.
+! See http://factorcode.org/license.txt for BSD license.
+USING: combinators.lib kernel math math.functions math.parser namespaces
+    sequences splitting sequences.lib ;
+IN: math.text
+
+<PRIVATE
+
+: small-numbers ( n -- str )
+    { "Zero" "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine"
+    "Ten" "Eleven" "Twelve" "Thirteen" "Fourteen" "Fifteen" "Sixteen"
+    "Seventeen" "Eighteen" "Nineteen" } nth ;
+
+: tens ( n -- str )
+    { "" "" "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ;
+
+: scale-numbers ( n -- str )  ! up to 10^99
+    { "" "Thousand" "Million" "Billion" "Trillion" "Quadrillion" "Quintillion"
+    "Sextillion" "Septillion" "Octillion" "Nonillion" "Decillion" "Undecillion"
+    "Duodecillion" "Tredecillion" "Quattuordecillion" "Quindecillion"
+    "Sexdecillion" "Septendecillion" "Octodecillion" "Novemdecillion"
+    "Vigintillion" "Unvigintillion" "Duovigintillion" "Trevigintillion"
+    "Quattuorvigintillion" "Quinvigintillion" "Sexvigintillion"
+    "Septvigintillion" "Octovigintillion" "Novemvigintillion" "Trigintillion"
+    "Untrigintillion" "Duotrigintillion" } nth ;
+
+SYMBOL: and-needed?
+: set-conjunction ( seq -- )
+    first {
+        [ dup 100 < ]
+        [ dup 0 > ]
+    } && and-needed? set drop ;
+
+: negative-text ( n -- str )
+    0 < "Negative " "" ? ;
+
+: 3digit-groups ( n -- seq )
+    number>string <reversed> 3 <groups>
+    [ reverse 10 string>integer ] map ;
+
+: hundreds-place ( n -- str )
+    100 /mod swap dup zero? [
+        2drop ""
+    ] [
+        small-numbers " Hundred" append
+        swap zero? [ " and " append ] unless
+    ] if ;
+
+: tens-place ( n -- str )
+    100 mod dup 20 >= [
+        10 /mod >r tens r>
+        dup zero? [ drop ] [ "-" swap small-numbers 3append ] if
+    ] [
+        dup zero? [ drop "" ] [ small-numbers ] if
+    ] if ;
+
+: 3digits>text ( n -- str )
+    dup hundreds-place swap tens-place append ;
+
+: text-with-scale ( index seq -- str )
+    dupd nth 3digits>text swap
+    scale-numbers dup empty? [
+        drop
+    ] [
+        " " swap 3append
+    ] if ;
+
+: append-with-conjunction ( str1 str2 -- newstr )
+    over length zero? [
+        nip
+    ] [
+        and-needed? get " and " ", " ? rot 3append
+        and-needed? off
+    ] if ;
+
+: (recombine) ( str index seq -- newstr seq )
+    2dup nth zero? [
+        nip
+    ] [
+        [ text-with-scale ] keep
+        -rot append-with-conjunction swap
+    ] if ;
+
+: recombine ( seq -- str )
+    dup singleton? [
+        first 3digits>text
+    ] [
+        dup set-conjunction "" swap
+        dup length [ swap (recombine) ] each drop
+    ] if ;
+
+: (number>text) ( n -- str )
+    dup negative-text swap abs 3digit-groups recombine append ;
+
+PRIVATE>
+
+: number>text ( n -- str )
+    dup zero? [
+        small-numbers
+    ] [
+        [ (number>text) ] with-scope
+    ] if ;
+