make round be round-ties-even, miscellaneous changes to the rounding procedures

crates/steel-core/src/primitives/numbers.rs

@@ -2,8 +2,9 @@ use crate::rvals::{IntoSteelVal, Result, SteelComplex, SteelVal};
 use crate::{steelerr, stop, throw};
 use num_bigint::BigInt;
 use num_integer::Integer;
-use num_rational::{BigRational, Rational32};
-use num_traits::{pow::Pow, CheckedAdd, CheckedMul, Signed, ToPrimitive, Zero};
+use num_rational::{BigRational, Ratio, Rational32};
+use num_traits::{pow::Pow, CheckedAdd, CheckedMul, One, Signed, ToPrimitive, Zero};
+use std::cmp::Ordering;
 use std::ops::Neg;
 
 /// Checks if the given value is a number
@@ -358,18 +359,6 @@ pub fn multiply_primitive(args: &[SteelVal]) -> Result<SteelVal> {
     multiply_primitive_impl(args)
 }
 
-#[steel_derive::function(name = "truncate", constant = true)]
-pub fn truncate(arg: &SteelVal) -> Result<SteelVal> {
-    match arg {
-        SteelVal::NumV(n) => n.trunc().into_steelval(),
-        SteelVal::IntV(i) => Ok(SteelVal::IntV(*i)),
-        // SteelVal::Rational(ratio) => ratio.trunc(),
-        SteelVal::BigNum(gc) => Ok(SteelVal::BigNum(gc.clone())),
-        // SteelVal::BigRational(gc) => gc.trunc(),
-        _ => stop!(TypeMismatch => "truncate expects a real number, found: {}", arg),
-    }
-}
-
 /// Returns quotient of dividing numerator by denomintator.
 ///
 /// (quotient numerator denominator) -> integer?
@@ -837,29 +826,6 @@ fn abs(number: &SteelVal) -> Result<SteelVal> {
     }
 }
 
-/// Rounds the given number up to the nearest integer not less than it.
-///
-/// (ceiling number) -> integer?
-///
-/// * number : number? - The number to round up.
-///
-/// # Examples
-/// ```scheme
-/// > (ceiling 42) ;; => 42
-/// > (ceiling 42.1) ;; => 43
-/// > (ceiling -42.1) ;; => -42
-/// ```
-#[steel_derive::function(name = "ceiling", constant = true)]
-fn ceiling(number: &SteelVal) -> Result<SteelVal> {
-    match number {
-        n @ SteelVal::IntV(_) | n @ SteelVal::BigNum(_) => Ok(n.clone()),
-        SteelVal::NumV(n) => Ok(SteelVal::NumV(n.ceil())),
-        SteelVal::Rational(f) => f.ceil().into_steelval(),
-        SteelVal::BigRational(f) => f.ceil().into_steelval(),
-        _ => steelerr!(TypeMismatch => "ceiling expects a real number, found: {}", number),
-    }
-}
-
 /// Retrieves the denominator of the given rational number.
 ///
 /// (denominator number) -> integer?
@@ -1065,11 +1031,34 @@ fn exp(left: &SteelVal) -> Result<SteelVal> {
     }
 }
 
-/// Computes the largest integer less than or equal to the given number.
+/// Retrieves the numerator of the given rational number.
+///
+/// (numerator number) -> number?
+///
+/// * number : number? - The rational number to retrieve the numerator from.
+///
+/// # Examples
+/// ```scheme
+/// > (numerator 3/4) ;; => 3
+/// > (numerator 5/2) ;; => 5
+/// > (numerator -2) ;; => -2
+/// ```
+#[steel_derive::function(name = "numerator", constant = true)]
+fn numerator(number: &SteelVal) -> Result<SteelVal> {
+    match number {
+        SteelVal::IntV(x) => x.into_steelval(),
+        SteelVal::Rational(x) => (*x.numer() as isize).into_steelval(),
+        SteelVal::BigNum(x) => Ok(SteelVal::BigNum(x.clone())),
+        SteelVal::BigRational(x) => (x.numer().clone()).into_steelval(),
+        _ => steelerr!(Generic => "numerator expects an integer or rational number"),
+    }
+}
+
+/// Rounds the given number down to the nearest integer not larger than it.
 ///
 /// (floor number) -> number?
 ///
-/// * number : number? - The number to compute the floor for.
+/// * number : real? - The number to compute the floor for.
 ///
 /// # Examples
 /// ```scheme
@@ -1085,52 +1074,127 @@ fn floor(number: &SteelVal) -> Result<SteelVal> {
         SteelVal::Rational(x) => x.floor().into_steelval(),
         SteelVal::BigNum(x) => Ok(SteelVal::BigNum(x.clone())),
         SteelVal::BigRational(x) => x.floor().into_steelval(),
-        _ => steelerr!(Generic => "floor expected a real number"),
+        _ => steelerr!(Generic => "floor expects a real number, found: {}", number),
     }
 }
 
-/// Retrieves the numerator of the given rational number.
+/// Rounds the given number up to the nearest integer not less than it.
 ///
-/// (numerator number) -> number?
+/// (ceiling number) -> integer?
 ///
-/// * number : number? - The rational number to retrieve the numerator from.
+/// * number : real? - The number to round up.
 ///
 /// # Examples
 /// ```scheme
-/// > (numerator 3/4) ;; => 3
-/// > (numerator 5/2) ;; => 5
-/// > (numerator -2) ;; => -2
+/// > (ceiling 42) ;; => 42
+/// > (ceiling 42.1) ;; => 43
+/// > (ceiling -42.1) ;; => -42
 /// ```
-#[steel_derive::function(name = "numerator", constant = true)]
-fn numerator(number: &SteelVal) -> Result<SteelVal> {
+#[steel_derive::function(name = "ceiling", constant = true)]
+fn ceiling(number: &SteelVal) -> Result<SteelVal> {
     match number {
-        SteelVal::IntV(x) => x.into_steelval(),
-        SteelVal::Rational(x) => (*x.numer() as isize).into_steelval(),
-        SteelVal::BigNum(x) => Ok(SteelVal::BigNum(x.clone())),
-        SteelVal::BigRational(x) => (x.numer().clone()).into_steelval(),
-        _ => steelerr!(Generic => "numerator expects an integer or rational number"),
+        n @ SteelVal::IntV(_) | n @ SteelVal::BigNum(_) => Ok(n.clone()),
+        SteelVal::NumV(n) => Ok(SteelVal::NumV(n.ceil())),
+        SteelVal::Rational(f) => f.ceil().into_steelval(),
+        SteelVal::BigRational(f) => f.ceil().into_steelval(),
+        _ => steelerr!(TypeMismatch => "ceiling expects a real number, found: {}", number),
+    }
+}
+
+/// Rounds the given number to the nearest integer, whose absolute value is not
+/// larger than it.
+///
+/// (truncate number) -> integer?
+///
+/// * number : real? - The number to truncate.
+///
+/// # Examples
+///
+/// ```scheme
+/// > (truncate 42) ;; => 42
+/// > (truncate 42.1) ;; => 42
+/// > (truncate -42.1) ;; => -42
+/// ```
+#[steel_derive::function(name = "truncate", constant = true)]
+pub fn truncate(arg: &SteelVal) -> Result<SteelVal> {
+    match arg {
+        SteelVal::NumV(n) => n.trunc().into_steelval(),
+        SteelVal::IntV(i) => Ok(SteelVal::IntV(*i)),
+        SteelVal::Rational(ratio) => ratio.trunc().into_steelval(),
+        SteelVal::BigNum(gc) => Ok(SteelVal::BigNum(gc.clone())),
+        SteelVal::BigRational(gc) => gc.trunc().into_steelval(),
+        _ => stop!(TypeMismatch => "truncate expects a real number, found: {}", arg),
+    }
+}
+
+/// Rounds to the nearest integer. Rounds half-way cases to even.
+///
+/// Reimplementation of https://github.com/rust-num/num-rational/pull/141,
+/// while that one isn't merged yet.
+fn rational_round_ties_even<T>(num: &Ratio<T>) -> Ratio<T>
+where
+    T: Zero + One + Integer + Clone,
+{
+    let zero: Ratio<T> = Zero::zero();
+    let one: T = One::one();
+    let two: T = one.clone() + one.clone();
+
+    // Find unsigned fractional part of rational number
+    let mut fractional = num.fract();
+    if fractional < zero {
+        fractional = zero - fractional
+    };
+
+    // Compare the unsigned fractional part with 1/2
+    let half = Ratio::new_raw(one, two);
+    match fractional.cmp(&half) {
+        Ordering::Greater => {
+            let one: Ratio<T> = One::one();
+            if *num >= Zero::zero() {
+                num.trunc() + one
+            } else {
+                num.trunc() - one
+            }
+        }
+        Ordering::Equal => {
+            let trunc = num.trunc();
+            if trunc.numer().is_even() {
+                trunc
+            } else {
+                let one: Ratio<T> = One::one();
+                if *num >= Zero::zero() {
+                    num.trunc() + one
+                } else {
+                    num.trunc() - one
+                }
+            }
+        }
+        Ordering::Less => num.trunc(),
     }
 }
 
-/// Rounds the given number to the nearest integer.
+/// Rounds the given number to the nearest integer, rounding half-way cases to
+/// the even number.
 ///
 /// (round number) -> number?
 ///
-/// * number : number? - The number to round.
+/// * number : real? - The number to round.
 ///
 /// # Examples
 /// ```scheme
 /// > (round 3.14) ;; => 3
 /// > (round 4.6) ;; => 5
-/// > (round -2.5) ;; => -3
+/// > (round 2.5) ;; => 2
+/// > (round 3.5) ;; => 4
+/// > (round -2.5) ;; => -2
 /// ```
 #[steel_derive::function(name = "round", constant = true)]
 fn round(number: &SteelVal) -> Result<SteelVal> {
     match number {
         SteelVal::IntV(i) => i.into_steelval(),
-        SteelVal::NumV(n) => n.round().into_steelval(),
-        SteelVal::Rational(f) => f.round().into_steelval(),
-        SteelVal::BigRational(f) => f.round().into_steelval(),
+        SteelVal::NumV(n) => n.round_ties_even().into_steelval(),
+        SteelVal::Rational(f) => rational_round_ties_even(f).into_steelval(),
+        SteelVal::BigRational(f) => rational_round_ties_even(f).into_steelval(),
         SteelVal::BigNum(n) => Ok(SteelVal::BigNum(n.clone())),
         _ => steelerr!(TypeMismatch => "round expects a real number, found: {}", number),
     }

crates/steel-core/src/tests/success/numbers.scm

@@ -188,16 +188,22 @@
 
 (assert-equal! 10.0 (ceiling 9.1))
 (assert-equal! 9.0 (floor 9.1))
+(assert-equal! 9.0 (truncate 9.1))
 (assert-equal! 10.0 (ceiling 10.0))
 (assert-equal! 10.0 (floor 10.0))
+(assert-equal! 10.0 (truncate 10.0))
 (assert-equal! 10 (ceiling 10))
 (assert-equal! 10 (floor 10))
+(assert-equal! 10 (truncate 10))
 (assert-equal! -9.0 (ceiling -9.1))
 (assert-equal! -10.0 (floor -9.1))
+(assert-equal! -9.0 (truncate -9.1))
 (assert-equal! 1 (ceiling 1/2))
 (assert-equal! 0 (floor 1/2))
+(assert-equal! 0 (truncate 1/2))
 (assert-equal! 0 (ceiling -1/2))
 (assert-equal! -1 (floor -1/2))
+(assert-equal! 0 (truncate -1/2))
 
 (assert-equal! 3 (numerator 3))
 (assert-equal! 3 (numerator 3/2))
@@ -220,6 +226,14 @@
 (assert-equal! 3.0 (round 2.6))
 (assert-equal! 9223372036854775808 (round 9223372036854775808))
 
+;; round-ties-even
+(assert-equal! -2.0 (round -1.5))
+(assert-equal! 2.0 (round 2.5))
+(assert-equal! 4.0 (round 3.5))
+(assert-equal! 2 (round 5/2))
+(assert-equal! 4 (round (+ 4 1/2)))
+(assert-equal! 4 (round 7/2))
+
 (assert-equal! 4 (square 2))
 (assert-equal! 2 (sqrt 4))
 (assert-equal! 4.0 (square 2.0))

docs/src/builtins/steel_base.md

@@ -432,7 +432,7 @@ Rounds the given number up to the nearest integer not less than it.
 
 (ceiling number) -> integer?
 
-* number : number? - The number to round up.
+* number : real? - The number to round up.
 
 #### Examples
 ```scheme
@@ -1068,11 +1068,11 @@ Checks if the given value is a floating-point number
 > (float? #t) ;; => #f
 ```
 ### **floor**
-Computes the largest integer less than or equal to the given number.
+Rounds the given number down to the nearest integer not larger than it.
 
 (floor number) -> number?
 
-* number : number? - The number to compute the floor for.
+* number : real? - The number to compute the floor for.
 
 #### Examples
 ```scheme
@@ -2476,17 +2476,20 @@ This function takes time proportional to the length of `lst`.
 > (reverse (list 1 2 3 4)) ;; '(4 3 2 1)
 ```
 ### **round**
-Rounds the given number to the nearest integer.
+Rounds the given number to the nearest integer, rounding half-way cases to
+the even number.
 
 (round number) -> number?
 
-* number : number? - The number to round.
+* number : real? - The number to round.
 
 #### Examples
 ```scheme
 > (round 3.14) ;; => 3
 > (round 4.6) ;; => 5
-> (round -2.5) ;; => -3
+> (round 2.5) ;; => 2
+> (round 3.5) ;; => 4
+> (round -2.5) ;; => -2
 ```
 ### **second**
 Get the second element of the list. Raises an error if the list does not have an element in the second position.
@@ -3133,6 +3136,21 @@ of the string
 ```scheme
 > (trim-start-matches "123foo1bar123123" "123") ;; => "foo1bar123123"
 ```
+### **truncate**
+Rounds the given number to the nearest integer, whose absolute value is not
+larger than it.
+
+(truncate number) -> integer?
+
+* number : real? - The number to truncate.
+
+#### Examples
+
+```scheme
+> (truncate 42) ;; => 42
+> (truncate 42.1) ;; => 42
+> (truncate -42.1) ;; => -42
+```
 ### **utf8->string**
 Alias of `bytes->string/utf8`.
 ### **utf8-length**
@@ -3566,7 +3584,6 @@ Create a zipping iterator
 ### **thread/available-parallelism**
 ### **thread::current/id**
 ### **transduce**
-### **truncate**
 ### **try-list-ref**
 ### **unbox**
 ### **unbox-strong**