diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index 047887bcc8..e4d66d4725 100644 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -72,9 +72,9 @@ MACRO: nfirst ( n -- ) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: sigma ( seq quot -- n ) [ rot slip + ] curry 0 swap reduce ; +: sigma ( seq quot -- n ) [ rot slip + ] curry 0 swap reduce ; inline -: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; +: count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline : all-unique? ( seq -- ? ) [ prune ] keep [ length ] 2apply = ; diff --git a/extra/math/text/authors.txt b/extra/math/text/authors.txt new file mode 100644 index 0000000000..4eec9c9a08 --- /dev/null +++ b/extra/math/text/authors.txt @@ -0,0 +1 @@ +Aaron Schaefer diff --git a/extra/math/text/summary.txt b/extra/math/text/summary.txt new file mode 100644 index 0000000000..96b2f4f151 --- /dev/null +++ b/extra/math/text/summary.txt @@ -0,0 +1 @@ +Convert integers to text diff --git a/extra/math/text/text-docs.factor b/extra/math/text/text-docs.factor new file mode 100644 index 0000000000..6a896b1a82 --- /dev/null +++ b/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\"" } } ; diff --git a/extra/math/text/text-tests.factor b/extra/math/text/text-tests.factor new file mode 100644 index 0000000000..09c8a0461b --- /dev/null +++ b/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 diff --git a/extra/math/text/text.factor b/extra/math/text/text.factor new file mode 100644 index 0000000000..7298fd3c15 --- /dev/null +++ b/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 + + ] + } && and-needed? set drop ; + +: negative-text ( n -- str ) + 0 < "Negative " "" ? ; + +: 3digit-groups ( n -- seq ) + number>string 3 + [ 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 ; +