! Copyright (c) 2009 Samuel Tardieu.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators kernel math math.functions
-math.parser math.text.utils memoize sequences ;
+math.parser math.text.utils sequences splitting ;
IN: math.text.french
<PRIVATE
! 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 ;
: over-1000000 ( n -- str )
3 digit-groups [ 1 + units nth n-units ] map-index sift
- reverse " " join ;
+ reverse join-words ;
: decompose ( n -- str ) 1000000 /mod [ over-1000000 ] dip
dup 0 > [ basic space-append ] [ drop ] if ;
[ 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 ;