math.extras: adding round-to-decimal.

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" }
+} ;

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

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 ;