-! Copyright (c) 2007 Aaron Schaefer.
+! Copyright (c) 2007, 2008, 2018 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators.lib kernel math math.functions math.parser namespaces
- sequences splitting grouping sequences.lib
- combinators.short-circuit ;
+USING: combinators combinators.short-circuit kernel math
+math.order math.parser math.text.utils namespaces sequences
+splitting ;
IN: math.text.english
<PRIVATE
: small-numbers ( n -- str )
- { "Zero" "One" "Two" "Three" "Four" "Five" "Six" "Seven" "Eight" "Nine"
- "Ten" "Eleven" "Twelve" "Thirteen" "Fourteen" "Fifteen" "Sixteen"
- "Seventeen" "Eighteen" "Nineteen" } nth ;
+ {
+ "zero" "one" "two" "three" "four" "five" "six"
+ "seven" "eight" "nine" "ten" "eleven" "twelve"
+ "thirteen" "fourteen" "fifteen" "sixteen" "seventeen"
+ "eighteen" "nineteen"
+ } nth ;
: tens ( n -- str )
- { f f "Twenty" "Thirty" "Forty" "Fifty" "Sixty" "Seventy" "Eighty" "Ninety" } nth ;
+ {
+ 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" "Quintillion"
- "Sextillion" "Septillion" "Octillion" "Nonillion" "Decillion" "Undecillion"
- "Duodecillion" "Tredecillion" "Quattuordecillion" "Quindecillion"
- "Sexdecillion" "Septendecillion" "Octodecillion" "Novemdecillion"
- "Vigintillion" "Unvigintillion" "Duovigintillion" "Trevigintillion"
- "Quattuorvigintillion" "Quinvigintillion" "Sexvigintillion"
- "Septvigintillion" "Octovigintillion" "Novemvigintillion" "Trigintillion"
- "Untrigintillion" "Duotrigintillion" } nth ;
+ {
+ f "thousand" "million" "billion" "trillion" "quadrillion"
+ "quintillion" "sextillion" "septillion" "octillion"
+ "nonillion" "decillion" "undecillion" "duodecillion"
+ "tredecillion" "quattuordecillion" "quindecillion"
+ "sexdecillion" "septendecillion" "octodecillion" "novemdecillion"
+ "vigintillion" "unvigintillion" "duovigintillion" "trevigintillion"
+ "quattuorvigintillion" "quinvigintillion" "sexvigintillion"
+ "septvigintillion" "octovigintillion" "novemvigintillion"
+ "trigintillion" "untrigintillion" "duotrigintillion"
+ } nth ;
SYMBOL: and-needed?
: set-conjunction ( seq -- )
- first { [ dup 100 < ] [ dup 0 > ] } 0&& and-needed? set drop ;
+ first { [ 100 < ] [ 0 > ] } 1&& and-needed? set ;
: negative-text ( n -- str )
- 0 < "Negative " "" ? ;
-
-: 3digit-groups ( n -- seq )
- number>string <reversed> 3 <groups>
- [ reverse string>number ] map ;
+ 0 < "negative " "" ? ;
: hundreds-place ( n -- str )
- 100 /mod swap dup zero? [
+ 100 /mod over 0 = [
2drop ""
] [
- small-numbers " Hundred" append
- swap zero? [ " and " append ] unless
+ [ small-numbers " hundred" append ] dip
+ 0 = [ " and " append ] unless
] if ;
: tens-place ( n -- str )
100 mod dup 20 >= [
10 /mod [ tens ] dip
- dup zero? [ drop ] [ "-" swap small-numbers 3append ] if
+ [ small-numbers "-" glue ] unless-zero
] [
- dup zero? [ drop "" ] [ small-numbers ] if
+ [ "" ] [ small-numbers ] if-zero
] if ;
: 3digits>text ( n -- str )
- dup hundreds-place swap tens-place append ;
+ [ hundreds-place ] [ tens-place ] bi append ;
: text-with-scale ( index seq -- str )
- dupd nth 3digits>text swap
- scale-numbers [
- " " swap 3append
- ] unless-empty ;
+ [ nth 3digits>text ] [ drop scale-numbers ] 2bi
+ [ " " glue ] unless-empty ;
: append-with-conjunction ( str1 str2 -- newstr )
- over length zero? [
- nip
- ] [
- and-needed? get " and " ", " ? rot 3append
+ swap [
+ and-needed? get " and " ", " ? glue
and-needed? off
- ] if ;
+ ] unless-empty ;
-: (recombine) ( str index seq -- newstr seq )
- 2dup nth zero? [
- nip
+: (recombine) ( str index seq -- newstr )
+ 2dup nth 0 = [
+ 2drop
] [
- [ text-with-scale ] keep
- -rot append-with-conjunction swap
+ text-with-scale append-with-conjunction
] if ;
: recombine ( seq -- str )
dup length 1 = [
first 3digits>text
] [
- dup set-conjunction "" swap
- dup length [ swap (recombine) ] each drop
+ [ set-conjunction "" ] [ length ] [ ] tri
+ [ (recombine) ] curry each-integer
] if ;
: (number>text) ( n -- str )
- dup negative-text swap abs 3digit-groups recombine append ;
+ [ negative-text ] [ abs 3 digit-groups recombine ] bi append ;
PRIVATE>
-: number>text ( n -- str )
- dup zero? [
- small-numbers
+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*
] [
- [ (number>text) ] with-scope
+ [ 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* ;
projects / factor.git / blobdiff