New math.text vocab converts numbers to English

db4
Aaron Schaefer 2007-12-24 00:06:53 -05:00
parent fc403b373b
commit 5fd3d34302
5 changed files with 127 additions and 0 deletions

View File

@ -0,0 +1 @@
Aaron Schaefer

View File

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

View File

@ -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\"" } } ;

View File

@ -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

103
extra/math/text/text.factor Normal file
View File

@ -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 ;