-! 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
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"
: 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 )
[ " " 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 = [
first 3digits>text
] [
[ set-conjunction "" ] [ length ] [ ] tri
- [ (recombine) ] curry each
+ [ (recombine) ] curry each-integer
] if ;
: (number>text) ( n -- str )
- [ negative-text ] [ abs 3digit-groups recombine ] bi append ;
+ [ negative-text ] [ abs 3 digit-groups recombine ] bi append ;
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* ;