diff --git a/basis/math/functions/functions-docs.factor b/basis/math/functions/functions-docs.factor index dac39428e0..13484ce500 100644 --- a/basis/math/functions/functions-docs.factor +++ b/basis/math/functions/functions-docs.factor @@ -40,6 +40,7 @@ ARTICLE: "arithmetic-functions" "Arithmetic functions" floor truncate round + round-to } "Inexact comparison:" { $subsections ~ } @@ -328,6 +329,15 @@ HELP: round { $description "Outputs the whole number closest to " { $snippet "x" } "." } { $notes "The result is not necessarily an integer." } ; +HELP: round-to +{ $values { "x" real } { "n" integer } { "y" real } } +{ $description "Outputs the number closest to " { $snippet "x" } ", rounded to " { $snippet "n" } " decimals." } +{ $notes "The result is not necessarily an integer." } +{ $examples + { $example "USING: math.functions prettyprint ;" "1.23456 2 round-to ." "1.23" } + { $example "USING: math.functions prettyprint ;" "12345.6789 -3 round-to ." "12000.0" } +} ; + HELP: roots { $values { "x" number } { "t" integer } { "seq" sequence } } { $description "Outputs the " { $snippet "t" } " roots of a number " { $snippet "x" } "." } diff --git a/basis/math/functions/functions-tests.factor b/basis/math/functions/functions-tests.factor index 3880e4c508..e6d79a8428 100644 --- a/basis/math/functions/functions-tests.factor +++ b/basis/math/functions/functions-tests.factor @@ -255,3 +255,19 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11 { -1.0 } [ -1 -0.0 copysign ] unit-test { 1.5 } [ -1.5 2 copysign ] unit-test { -1.5 } [ -1.5 -2 copysign ] unit-test + +{ 0.0 } [ 0 2 round-to ] unit-test +{ 1.0 } [ 1 2 round-to ] unit-test +{ 1.23 } [ 1.2349 2 round-to ] unit-test +{ 1.24 } [ 1.2350 2 round-to ] unit-test +{ 1.24 } [ 1.2351 2 round-to ] unit-test +{ -1.23 } [ -1.2349 2 round-to ] unit-test +{ -1.24 } [ -1.2350 2 round-to ] unit-test +{ -1.24 } [ -1.2351 2 round-to ] 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 ] with map ] unit-test diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index d2dd108549..340bbff202 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -396,3 +396,6 @@ M: float copysign [ double>bits ] [ fp-sign ] bi* [ 63 2^ bitor ] [ 63 2^ bitnot bitand ] if bits>double ; + +: round-to ( x n -- y ) + 10^ [ * 0.5 over 0 > [ + ] [ - ] if truncate ] [ / ] bi ;