move math.extras:round-to-even to math.functions to use in basis:formatting

Also add round-to-odd in case it is needed.
Also change float rounding to be independent of the current rounding mode

basis/math/functions/functions-docs.factor

@@ -325,6 +325,24 @@ HELP: round
     { $example "USING: math.functions prettyprint ;" "4.4 round ." "4.0" }
 } ;
 
+HELP: round-to-even
+{ $values { "x" real } { "y" "a whole real number" } }
+{ $description "Outputs the whole number closest to " { $snippet "x" } ", rounding out at half, breaking ties towards even numbers. This is also known as banker's rounding or unbiased rounding." }
+{ $notes "The result is not necessarily an integer." }
+{ $examples
+    { $example "USING: math.functions prettyprint ;" "0.5 round-to-even ." "0.0" }
+    { $example "USING: math.functions prettyprint ;" "1.5 round-to-even ." "2.0" }
+} ;
+
+HELP: round-to-odd
+{ $values { "x" real } { "y" "a whole real number" } }
+{ $description "Outputs the whole number closest to " { $snippet "x" } ", rounding out at half, breaking ties towards odd numbers." }
+{ $notes "The result is not necessarily an integer." }
+{ $examples
+    { $example "USING: math.functions prettyprint ;" "0.5 round-to-odd ." "1.0" }
+    { $example "USING: math.functions prettyprint ;" "1.5 round-to-odd ." "1.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

@@ -200,6 +200,32 @@ CONSTANT: log10-factorial-1000 0x1.40f3593ed6f8ep11
 { { +fp-invalid-operation+ } } [ [ NAN: 4000000000000 ceiling drop ] collect-fp-exceptions ] unit-test
 { { +fp-invalid-operation+ } } [ [ NAN: 4000000000000 floor drop ] collect-fp-exceptions ] unit-test
 
+{ -5 } [ -4-3/5 round-to-even ] unit-test
+{ -4 } [ -4-1/2 round-to-even ] unit-test
+{ -4 } [ -4-2/5 round-to-even ] unit-test
+{ 5 } [ 4+3/5 round-to-even ] unit-test
+{ 4 } [ 4+1/2 round-to-even ] unit-test
+{ 4 } [ 4+2/5 round-to-even ] unit-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
+{ 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
+
+{ -5 } [ -4-3/5 round-to-odd ] unit-test
+{ -5 } [ -4-1/2 round-to-odd ] unit-test
+{ -4 } [ -4-2/5 round-to-odd ] unit-test
+{ 5 } [ 4+3/5 round-to-odd ] unit-test
+{ 5 } [ 4+1/2 round-to-odd ] unit-test
+{ 4 } [ 4+2/5 round-to-odd ] unit-test
+{ -5.0 } [ -4.6 round-to-odd ] unit-test
+{ -5.0 } [ -4.5 round-to-odd ] unit-test
+{ -4.0 } [ -4.4 round-to-odd ] unit-test
+{ 5.0 } [ 4.6 round-to-odd ] unit-test
+{ 5.0 } [ 4.5 round-to-odd ] unit-test
+{ 4.0 } [ 4.4 round-to-odd ] unit-test
+
 { 6 59967 } [ 3837888 factor-2s ] unit-test
 { 6 -59967 } [ -3837888 factor-2s ] unit-test
 

basis/math/functions/functions.factor

@@ -375,13 +375,45 @@ M: float truncate
 
 GENERIC: round ( x -- y )
 
+GENERIC: round-to-even ( x -- y )
+
+GENERIC: round-to-odd ( x -- y )
+
 M: integer round ; inline
 
-M: ratio round
-    >fraction [ /mod dup abs 2 * ] keep >= [ 0 < -1 1 ? + ] [ drop ] if ;
+M: integer round-to-even ; inline
+
+M: integer round-to-odd ; inline
+
+: (round-tiebreak?) ( quotient rem denom tiebreak-quot -- q ? )
+    [ [ > ] ] dip [ 2dip = and ] curry 3bi or ; inline
+
+: (round-to-even?) ( quotient rem denom -- quotient ? )
+    [ >integer odd? ] (round-tiebreak?) ; inline
+
+: (round-to-odd?) ( quotient rem denom -- quotient ? )
+    [ >integer even? ] (round-tiebreak?) ; inline
+
+: (ratio-round) ( x round-quot -- y )
+    [ >fraction [ /mod dup swapd abs 2 * ] keep ] [ call ] bi*
+    [ swap 0 < -1 1 ? + ] [ nip ] if ; inline
+
+: (float-round) ( x round-quot -- y )
+    [ dup 1 mod [ - ] keep dup swapd abs 0.5 ] [ call ] bi*
+    [ swap 0.0 < -1.0 1.0 ? + ] [ nip ] if ; inline
+
+M: ratio round [ >= ] (ratio-round) ;
+
+M: ratio round-to-even [ (round-to-even?) ] (ratio-round) ;
+
+M: ratio round-to-odd [ (round-to-odd?) ] (ratio-round) ;
 
 M: float round dup sgn 2 /f + truncate ;
 
+M: float round-to-even [ (round-to-even?) ] (float-round) ;
+
+M: float round-to-odd [ (round-to-odd?) ] (float-round) ;
+
 : floor ( x -- y )
     dup 1 mod
     [ dup 0 < [ - 1 - ] [ - ] if ] unless-zero ; foldable

extra/math/extras/extras-docs.factor

@@ -99,13 +99,6 @@ HELP: round-to-decimal
     { $example "USING: math.extras prettyprint ;" "12345.6789 -3 round-to-decimal ." "12000.0" }
 } ;
 
-HELP: round-to-even
-{ $values { "x" real } { "y" real } }
-{ $description "Rounds " { $snippet "x" } " towards the nearest even number. This is also known as banker's rounding or unbiased rounding." }
-{ $examples
-    { $example "USING: math.extras prettyprint ;" "0.5 round-to-even ." "0.0" }
-    { $example "USING: math.extras prettyprint ;" "1.5 round-to-even ." "2.0" } } ;
-
 HELP: kahan-sum
 { $values { "seq" sequence } { "n" float } }
 { $description "Calculates the summation of the sequence using the Kahan summation algorithm." } ;

extra/math/extras/extras-tests.factor

@@ -98,20 +98,6 @@ IN: math.extras.test
 { 3 } [ { 1 2 3 1 2 3 1 2 3 3 } majority ] unit-test
 { CHAR: C } [ "AAACCBBCCCBCC" majority ] unit-test
 
-{ -5 } [ -4-3/5 round-to-even ] unit-test
-{ -4 } [ -4-1/2 round-to-even ] unit-test
-{ -4 } [ -4-2/5 round-to-even ] unit-test
-{ 5 } [ 4+3/5 round-to-even ] unit-test
-{ 4 } [ 4+1/2 round-to-even ] unit-test
-{ 4 } [ 4+2/5 round-to-even ] unit-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
-{ 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

extra/math/extras/extras.factor

@@ -249,20 +249,6 @@ PRIVATE>
 : compression-dissimilarity ( a b -- n )
     compression-lengths + / ;
 
-GENERIC: round-to-even ( x -- y )
-
-M: integer round-to-even ; inline
-
-M: ratio round-to-even
-    >fraction [ /mod abs 2 * ] keep > [ dup 0 < -1 1 ? + ] when ;
-
-M: float round-to-even
-    dup 0 > [
-        dup 0x1p52 <= [ 0x1p52 + 0x1p52 - ] when
-    ] [
-        dup -0x1p52 >= [ 0x1p52 - 0x1p52 + ] when
-    ] if ;
-
 : round-to-decimal ( x n -- y )
     10^ [ * 0.5 over 0 > [ + ] [ - ] if truncate ] [ / ] bi ;