diff --git a/extra/math/extras/extras-docs.factor b/extra/math/extras/extras-docs.factor index 5b120e1bd2..cd477f8354 100644 --- a/extra/math/extras/extras-docs.factor +++ b/extra/math/extras/extras-docs.factor @@ -77,3 +77,12 @@ HELP: logspace[a,b] HELP: majority { $values { "seq" sequence } { "elt/f" object } } { $description "Returns the element of " { $snippet "seq" } " that is in the majority, provided there is such an element, using a linear-time majority vote algorithm." } ; + +HELP: round-to-decimal +{ $values { "x" real } { "n" integer } { "y" real } } +{ $description "Outputs the number closest to " { $snippet "x" } ", rounded to " { $snippet "n" } " decimal places." } +{ $notes "The result is not necessarily an integer." } +{ $examples + { $example "USING: math.extras prettyprint ;" "1.23456 2 round-to-decimal ." "1.23" } + { $example "USING: math.extras prettyprint ;" "12345.6789 -3 round-to-decimal ." "12000.0" } +} ; diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor index 4219c1df1f..9358bf19c1 100644 --- a/extra/math/extras/extras-tests.factor +++ b/extra/math/extras/extras-tests.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2012 John Benediktsson ! See http://factorcode.org/license.txt for BSD license -USING: arrays math math.extras math.ranges sequences tools.test ; +USING: arrays kernel math math.extras math.ranges sequences +tools.test ; IN: math.extras.test @@ -103,3 +104,19 @@ IN: math.extras.test [ 5.0 ] [ 4.6 round-to-even ] unit-test [ 4.0 ] [ 4.5 round-to-even ] unit-test [ 4.0 ] [ 4.4 round-to-even ] unit-test + +{ 0.0 } [ 0 2 round-to-decimal ] unit-test +{ 1.0 } [ 1 2 round-to-decimal ] unit-test +{ 1.23 } [ 1.2349 2 round-to-decimal ] unit-test +{ 1.24 } [ 1.2350 2 round-to-decimal ] unit-test +{ 1.24 } [ 1.2351 2 round-to-decimal ] unit-test +{ -1.23 } [ -1.2349 2 round-to-decimal ] unit-test +{ -1.24 } [ -1.2350 2 round-to-decimal ] unit-test +{ -1.24 } [ -1.2351 2 round-to-decimal ] unit-test +{ + { + 0.0 0.0 10000.0 12000.0 12300.0 12350.0 12346.0 12345.7 + 12345.68 12345.679 12345.6789 12345.6789 12345.678901 + 12345.6789012 12345.67890123 12345.678901235 + } +} [ 12345.67890123456 -6 9 [a,b] [ round-to-decimal ] with map ] unit-test diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor index b2b7fc313e..37478e3d0e 100644 --- a/extra/math/extras/extras.factor +++ b/extra/math/extras/extras.factor @@ -252,3 +252,6 @@ M: float round-to-even ] [ dup -0x1p52 >= [ 0x1p52 - 0x1p52 + ] when ] if ; + +: round-to-decimal ( x n -- y ) + 10^ [ * 0.5 over 0 > [ + ] [ - ] if truncate ] [ / ] bi ;