math.functions: adding "round-to".

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" } "." }

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

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 ;