Add French number>text support for ratios

char-rename
Samuel Tardieu 2017-03-23 12:05:45 +01:00
parent 5707acdaf0
commit 30f73d63f4
2 changed files with 32 additions and 1 deletions

View File

@ -20,3 +20,15 @@ USING: math math.functions math.parser math.text.french sequences tools.test ;
{ 104 } [ -1 10 102 ^ - number>text length ] unit-test
! Check that we do not exhaust stack
{ 1484 } [ 10 100 ^ 1 - number>text length ] unit-test
{ "un demi" } [ 1/2 number>text ] unit-test
{ "trois demis" } [ 3/2 number>text ] unit-test
{ "un tiers" } [ 1/3 number>text ] unit-test
{ "deux tiers" } [ 2/3 number>text ] unit-test
{ "un quart" } [ 1/4 number>text ] unit-test
{ "un cinquième" } [ 1/5 number>text ] unit-test
{ "un seizième" } [ 1/16 number>text ] unit-test
{ "mille cent-vingt-septièmes" } [ 1000/127 number>text ] unit-test
{ "mille-cent vingt-septièmes" } [ 1100/27 number>text ] unit-test
{ "mille-cent-dix-neuf septièmes" } [ 1119/7 number>text ] unit-test
{ "moins un quatre-vingtième" } [ -1/80 number>text ] unit-test
{ "moins dix-neuf quatre-vingtièmes" } [ -19/80 number>text ] unit-test

View File

@ -29,7 +29,7 @@ MEMO: units ( -- seq ) ! up to 10^99
! The only plurals we have to remove are "quatre-vingts" and "cents",
! which are also the only strings ending with "ts".
: unpluralize ( str -- newstr ) dup "ts" tail? [ but-last ] when ;
: pluralize ( str -- newstr ) CHAR: s suffix ;
: pluralize ( str -- newstr ) dup "s" tail? [ CHAR: s suffix ] unless ;
: space-append ( str1 str2 -- str ) " " glue ;
@ -88,9 +88,28 @@ MEMO: units ( -- seq ) ! up to 10^99
[ decompose ]
} cond ;
: ieme ( str -- str )
dup "ts" tail? [ but-last ] when
dup "e" tail? [ but-last ] when
dup "q" tail? [ CHAR: u suffix ] when
"ième" append ;
: divisor ( n -- str )
{
{ 2 [ "demi" ] }
{ 3 [ "tiers" ] }
{ 4 [ "quart" ] }
[ basic ieme ]
} case ;
PRIVATE>
GENERIC: number>text ( n -- str )
M: integer number>text
dup abs 102 10^ >= [ number>string ] [ basic ] if ;
M: ratio number>text
>fraction [ [ number>text ] keep ] [ divisor ] bi*
swap abs 1 > [ pluralize ] when
space-append ;