factor: trim using lists

[factor.git] / extra / math / text / english / english.factor

diff --git a/extra/math/text/english/english.factor b/extra/math/text/english/english.factor
index 5b2af13489fd7286b01e658fb5edbf59729904fb..662e46ef75f86157b2bd1b4a21a6396ad2652d99 100644 (file)
--- a/extra/math/text/english/english.factor
+++ b/extra/math/text/english/english.factor
@@ -1,7 +1,8 @@
-! Copyright (c) 2007, 2008 Aaron Schaefer.
+! Copyright (c) 2007, 2008, 2018 Aaron Schaefer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.short-circuit grouping kernel math math.parser
-math.text.utils namespaces sequences ;
+USING: combinators combinators.short-circuit kernel math
+math.order math.parser math.text.utils namespaces sequences
+splitting ;
 IN: math.text.english
 
 <PRIVATE
@@ -19,7 +20,7 @@ IN: math.text.english
         f f "twenty" "thirty" "forty" "fifty" "sixty"
         "seventy" "eighty" "ninety"
     } nth ;
-    
+
 : scale-numbers ( n -- str )  ! up to 10^99
     {
         f "thousand" "million" "billion" "trillion" "quadrillion"
@@ -51,9 +52,9 @@ SYMBOL: and-needed?
 : tens-place ( n -- str )
     100 mod dup 20 >= [
         10 /mod [ tens ] dip
-        dup 0 = [ drop ] [ small-numbers "-" glue ] if
+        [ small-numbers "-" glue ] unless-zero
     ] [
-        dup 0 = [ drop "" ] [ small-numbers ] if
+        [ "" ] [ small-numbers ] if-zero
     ] if ;
 
 : 3digits>text ( n -- str )
@@ -64,12 +65,10 @@ SYMBOL: and-needed?
     [ " " glue ] unless-empty ;
 
 : append-with-conjunction ( str1 str2 -- newstr )
-    over length 0 = [
-        nip
-    ] [
-        swap and-needed? get " and " ", " ?
-        glue and-needed? off
-    ] if ;
+    swap [
+        and-needed? get " and " ", " ? glue
+        and-needed? off
+    ] unless-empty ;
 
 : (recombine) ( str index seq -- newstr )
     2dup nth 0 = [
@@ -91,6 +90,47 @@ SYMBOL: and-needed?
 
 PRIVATE>
 
-: number>text ( n -- str )
-    dup zero? [ small-numbers ] [ [ (number>text) ] with-scope ] if ;
+GENERIC: number>text ( n -- str )
+
+M: integer number>text
+    [ "zero" ] [ [ (number>text) ] with-scope ] if-zero ;
+
+M: ratio number>text
+    >fraction [ number>text ] bi@ " divided by " glue ;
+
+M: float number>text
+    number>string "." split1 [
+        "-" ?head
+        [ string>number number>text ]
+        [ [ "negative " prepend ] when ] bi*
+    ] [
+        [ CHAR: 0 - small-numbers ] { } map-as join-words
+    ] bi* " point " glue ;
+
+M: complex number>text
+    >rect [ number>text ] [
+        [ 0 < " minus " " plus " ? ]
+        [ abs number>text " i" append ] bi
+    ] bi* 3append ;
+
+: ordinal-suffix ( n -- suffix )
+    abs dup 100 mod 11 13 between? [ drop "th" ] [
+        10 mod {
+            { 1 [ "st" ] }
+            { 2 [ "nd" ] }
+            { 3 [ "rd" ] }
+            [ drop "th" ]
+        } case
+    ] if ;
 
+: number-ap-style ( n -- str )
+    dup { [ integer? ] [ 0 9 between? ] } 1&&
+    [ number>text ] [ number>string ] if ;
+
+: ordinal-ap-style ( n -- str )
+    dup {
+        f "first" "second" "third" "fourth" "fifth" "sixth"
+        "seventh" "eighth" "ninth"
+    } ?nth [ nip ] [
+        [ number>string ] [ ordinal-suffix ] bi append
+    ] if* ;