formatting, fix %f and %e for ratios and integers

modern-harvey2
Jon Harper 2017-02-24 17:01:45 +01:00 committed by John Benediktsson
parent e1df9df735
commit 438e22fceb
3 changed files with 106 additions and 11 deletions

View File

@ -22,9 +22,9 @@ HELP: printf
{ { $snippet "%+Pd" } "Integer format (base 10)" "integer" } { { $snippet "%+Pd" } "Integer format (base 10)" "integer" }
{ { $snippet "%+Po" } "Octal format (base 8)" "integer" } { { $snippet "%+Po" } "Octal format (base 8)" "integer" }
{ { $snippet "%+Pb" } "Binary format (base 2)" "integer" } { { $snippet "%+Pb" } "Binary format (base 2)" "integer" }
{ { $snippet "%+P.De" } "Scientific notation" "integer, float" } { { $snippet "%+P.De" } "Scientific notation" "real" }
{ { $snippet "%+P.DE" } "Scientific notation" "integer, float" } { { $snippet "%+P.DE" } "Scientific notation" "real" }
{ { $snippet "%+P.Df" } "Fixed format" "integer, float" } { { $snippet "%+P.Df" } "Fixed format" "real" }
{ { $snippet "%+Px" } "Hexadecimal (base 16)" "integer" } { { $snippet "%+Px" } "Hexadecimal (base 16)" "integer" }
{ { $snippet "%+PX" } "Hexadecimal (base 16) uppercase" "integer" } { { $snippet "%+PX" } "Hexadecimal (base 16) uppercase" "integer" }
{ { $snippet "%[%?, %]" } "Sequence format" "sequence" } { { $snippet "%[%?, %]" } "Sequence format" "sequence" }

View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 John Benediktsson ! Copyright (C) 2008 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: calendar kernel formatting tools.test system ; USING: calendar formatting kernel math math.functions sequences
strings system tools.test ;
IN: formatting.tests IN: formatting.tests
[ "%s" printf ] must-infer [ "%s" printf ] must-infer
@ -21,12 +22,25 @@ IN: formatting.tests
{ "8.950" } [ 8.950179003580072 "%.3f" sprintf ] unit-test { "8.950" } [ 8.950179003580072 "%.3f" sprintf ] unit-test
{ "123.10" } [ 123.1 "%01.2f" sprintf ] unit-test { "123.10" } [ 123.1 "%01.2f" sprintf ] unit-test
{ "1.2346" } [ 1.23456789 "%.4f" sprintf ] unit-test { "1.2346" } [ 1.23456789 "%.4f" sprintf ] unit-test
{ "100000000000000000.50000" } [ 17 10^ 1/2 + "%20.5f" sprintf ] unit-test
{ "3.333333" } [ 3+1/3 "%f" sprintf ] unit-test
{ "3.666667" } [ 3+2/3 "%f" sprintf ] unit-test
{ "3.7" } [ 3+2/3 "%.1f" sprintf ] unit-test
{ "-3.7" } [ -3-2/3 "%.1f" sprintf ] unit-test
{ "-3.666667" } [ -3-2/3 "%f" sprintf ] unit-test
{ "-3.333333" } [ -3-1/3 "%f" sprintf ] unit-test
{ "3.14159265358979323846e+00" } [ 2646693125139304345 842468587426513207 / "%.20e" sprintf ] unit-test
{ "-0.500" } [ -1/2 "%.3f" sprintf ] unit-test
{ "0.010" } [ 1/100 "%.3f" sprintf ] unit-test
{ "100000000000000000000000.000000" } [ 23 10^ "%f" sprintf ] unit-test
{ "1.2" } [ 125/100 "%.1f" sprintf ] unit-test
{ "1.4" } [ 135/100 "%.1f" sprintf ] unit-test
{ "2.0" } [ 5/2 "%.0f" sprintf ] unit-test
{ "4.0" } [ 7/2 "%.0f" sprintf ] unit-test
{ " 1.23" } [ 1.23456789 "%6.2f" sprintf ] unit-test { " 1.23" } [ 1.23456789 "%6.2f" sprintf ] unit-test
{ "001100" } [ 12 "%06b" sprintf ] unit-test { "001100" } [ 12 "%06b" sprintf ] unit-test
{ "==14" } [ 12 "%'=4o" sprintf ] unit-test { "==14" } [ 12 "%'=4o" sprintf ] unit-test
{ "foo: 1 bar: 2" } [ { 1 2 3 } "foo: %d bar: %s" vsprintf ] unit-test { "foo: 1 bar: 2" } [ { 1 2 3 } "foo: %d bar: %s" vsprintf ] unit-test
{ "1.234000e+08" } [ 123400000 "%e" sprintf ] unit-test { "1.234000e+08" } [ 123400000 "%e" sprintf ] unit-test
{ "-1.234000e+08" } [ -123400000 "%e" sprintf ] unit-test { "-1.234000e+08" } [ -123400000 "%e" sprintf ] unit-test
{ "1.234567e+08" } [ 123456700 "%e" sprintf ] unit-test { "1.234567e+08" } [ 123456700 "%e" sprintf ] unit-test
@ -40,6 +54,36 @@ IN: formatting.tests
{ "-001.0E+01" } [ -10 "%+010.1E" sprintf ] unit-test { "-001.0E+01" } [ -10 "%+010.1E" sprintf ] unit-test
{ "+001.0E+01" } [ 10 "%+010.1E" sprintf ] unit-test { "+001.0E+01" } [ 10 "%+010.1E" sprintf ] unit-test
{ "+001.0E-01" } [ 0.1 "%+010.1E" sprintf ] unit-test { "+001.0E-01" } [ 0.1 "%+010.1E" sprintf ] unit-test
{ " e1" } [ 0xe1 "% x" sprintf ] unit-test
{ "+e1" } [ 0xe1 "%+x" sprintf ] unit-test
{ "-e1" } [ -0xe1 "% x" sprintf ] unit-test
{ "-e1" } [ -0xe1 "%+x" sprintf ] unit-test
{ "1.00000e+1000" } [ 1000 10^ "%.5e" sprintf ] unit-test
{ "1.00000e-1000" } [ -1000 10^ "%.5e" sprintf ] unit-test
{ t } [
1000 10^ "%.5f" sprintf
"1" ".00000" 1000 CHAR: 0 <string> glue =
] unit-test
{ t } [
-1000 10^ "%.1004f" sprintf
"0." "10000" 999 CHAR: 0 <string> glue =
] unit-test
{ "-1.00000e+1000" } [ 1000 10^ neg "%.5e" sprintf ] unit-test
{ "-1.00000e-1000" } [ -1000 10^ neg "%.5e" sprintf ] unit-test
{ t } [
1000 10^ neg "%.5f" sprintf
"-1" ".00000" 1000 CHAR: 0 <string> glue =
] unit-test
{ t } [
-1000 10^ neg "%.1004f" sprintf
"-0." "10000" 999 CHAR: 0 <string> glue =
] unit-test
{ "9007199254740991.0" } [ 53 2^ 1 - "%.1f" sprintf ] unit-test
{ "9007199254740992.0" } [ 53 2^ "%.1f" sprintf ] unit-test
{ "9007199254740993.0" } [ 53 2^ 1 + "%.1f" sprintf ] unit-test
{ "-9007199254740991.0" } [ 53 2^ 1 - neg "%.1f" sprintf ] unit-test
{ "-9007199254740992.0" } [ 53 2^ neg "%.1f" sprintf ] unit-test
{ "-9007199254740993.0" } [ 53 2^ 1 + neg "%.1f" sprintf ] unit-test
{ "ff" } [ 0xff "%x" sprintf ] unit-test { "ff" } [ 0xff "%x" sprintf ] unit-test
{ "FF" } [ 0xff "%X" sprintf ] unit-test { "FF" } [ 0xff "%X" sprintf ] unit-test

View File

@ -4,7 +4,8 @@ USING: accessors arrays assocs calendar calendar.english combinators
combinators.smart fry generalizations io io.streams.string combinators.smart fry generalizations io io.streams.string
kernel macros math math.functions math.parser namespaces kernel macros math math.functions math.parser namespaces
peg.ebnf present prettyprint quotations sequences peg.ebnf present prettyprint quotations sequences
sequences.generalizations strings unicode vectors ; sequences.generalizations strings unicode vectors
math.functions.integer-logs math.order ;
FROM: math.parser.private => format-float ; FROM: math.parser.private => format-float ;
IN: formatting IN: formatting
@ -28,12 +29,62 @@ IN: formatting
: >digits ( string -- digits ) : >digits ( string -- digits )
[ 0 ] [ string>number ] if-empty ; [ 0 ] [ string>number ] if-empty ;
: format-simple ( x digits string -- string ) : format-decimal-simple ( x digits -- string )
[ >float "" -1 ] 2dip "C" format-float ; [
[ abs ] dip
[ 10^ * round-to-even >integer number>string ]
[ 1 + CHAR: 0 pad-head 2 CHAR: 0 pad-tail ]
[ 1 max cut* ] tri "." glue
] curry keep neg? [ CHAR: - prefix ] when ;
: format-scientific ( x digits -- string ) "e" format-simple ; : format-scientific-mantissa ( x log10x digits -- string )
swap - 10^ * round-to-even >integer
number>string 1 cut "." glue ;
: format-decimal ( x digits -- string ) "f" format-simple ; : format-scientific-exponent ( log10x -- string )
number>string 2 CHAR: 0 pad-head
dup CHAR: - swap index "e" "e+" ? prepend ;
: format-scientific-simple ( x digits -- string )
[
[ abs dup integer-log10 ] dip
[ format-scientific-mantissa ]
[ drop nip format-scientific-exponent ] 3bi append
] curry keep neg? [ CHAR: - prefix ] when ;
: format-float-fast ( x digits string -- string )
[ "" -1 ] 2dip "C" format-float ;
: format-fast-scientific? ( x digits -- x' digits ? )
over float? [ t ]
[ 2dup
[ abs integer-log10 abs 308 < ]
[ 15 < ] bi* and
[ [ [ >float ] dip ] when ] keep
] if ;
: format-scientific ( x digits -- string )
format-fast-scientific?
[ "e" format-float-fast ]
[ format-scientific-simple ] if ;
: format-fast-decimal? ( x digits -- x' digits ? )
over float? [ t ]
[
2dup
[ drop dup integer? [ abs 53 2^ < ] [ drop f ] if ]
[ over ratio?
[ [ abs integer-log10 ] dip
[ drop abs 308 < ] [ + 15 <= ] 2bi and ]
[ 2drop f ] if
] 2bi or
[ [ [ >float ] dip ] when ] keep
] if ; inline
: format-decimal ( x digits -- string )
format-fast-decimal?
[ "f" format-float-fast ]
[ format-decimal-simple ] if ;
ERROR: unknown-printf-directive ; ERROR: unknown-printf-directive ;