From 30f73d63f4031b35b52ecb28652aebf1a8e430f1 Mon Sep 17 00:00:00 2001
From: Samuel Tardieu <sam@rfc1149.net>
Date: Thu, 23 Mar 2017 12:05:45 +0100
Subject: [PATCH] Add French number>text support for ratios

---
 extra/math/text/french/french-tests.factor | 12 ++++++++++++
 extra/math/text/french/french.factor       | 21 ++++++++++++++++++++-
 2 files changed, 32 insertions(+), 1 deletion(-)

diff --git a/extra/math/text/french/french-tests.factor b/extra/math/text/french/french-tests.factor
index f76ee3a9f08..fe20af8cd54 100644
--- a/extra/math/text/french/french-tests.factor
+++ b/extra/math/text/french/french-tests.factor
@@ -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
diff --git a/extra/math/text/french/french.factor b/extra/math/text/french/french.factor
index e7927a2d7cf..d93308e8a1c 100644
--- a/extra/math/text/french/french.factor
+++ b/extra/math/text/french/french.factor
@@ -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 ;