>From 92dd2c4df82b8425fbd3d1359c749be3a21b743f Mon Sep 17 00:00:00 2001 From: Mark H Weaver Date: Sun, 13 Feb 2011 07:14:57 -0500 Subject: [PATCH 5/9] Optimize truncate, round, floor, and ceiling * libguile/numbers.c (scm_c_truncate): Use ceil (x) instead of -floor (-x). (scm_truncate_number): Implement directly instead of by checking the sign and using scm_floor or scm_ceiling. Use scm_truncate_quotient for fractions. Make extensible, so that new number types implemented in GOOPS will be able to do the job more efficiently, since it is often easier to implement truncate than floor or ceiling. (scm_round_number): Optimize fractions case by using scm_round_quotient. Make extensible, so that new number types implemented in GOOPS will be able to do the job efficiently. (scm_floor, scm_ceiling): Optimize fractions case by using scm_floor_quotient and scm_ceiling_quotient, respectively. * test-suite/tests/numbers.test: Add test cases. --- libguile/numbers.c | 87 +++------ test-suite/tests/numbers.test | 412 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 432 insertions(+), 67 deletions(-) diff --git a/libguile/numbers.c b/libguile/numbers.c index 9107c81..40a3ee3 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -8851,8 +8851,9 @@ scm_c_truncate (double x) return trunc (x); #else if (x < 0.0) - return -floor (-x); - return floor (x); + return ceil (x); + else + return floor (x); #endif } @@ -8898,43 +8899,41 @@ scm_c_round (double x) : result); } -SCM_DEFINE (scm_truncate_number, "truncate", 1, 0, 0, - (SCM x), - "Round the number @var{x} towards zero.") +SCM_PRIMITIVE_GENERIC (scm_truncate_number, "truncate", 1, 0, 0, + (SCM x), + "Round the number @var{x} towards zero.") #define FUNC_NAME s_scm_truncate_number { - if (scm_is_false (scm_negative_p (x))) - return scm_floor (x); + if (SCM_I_INUMP (x) || SCM_BIGP (x)) + return x; + else if (SCM_REALP (x)) + return scm_from_double (scm_c_truncate (SCM_REAL_VALUE (x))); + else if (SCM_FRACTIONP (x)) + return scm_truncate_quotient (SCM_FRACTION_NUMERATOR (x), + SCM_FRACTION_DENOMINATOR (x)); else - return scm_ceiling (x); + SCM_WTA_DISPATCH_1 (g_scm_truncate_number, x, SCM_ARG1, + s_scm_truncate_number); } #undef FUNC_NAME -SCM_DEFINE (scm_round_number, "round", 1, 0, 0, - (SCM x), - "Round the number @var{x} towards the nearest integer. " - "When it is exactly halfway between two integers, " - "round towards the even one.") +SCM_PRIMITIVE_GENERIC (scm_round_number, "round", 1, 0, 0, + (SCM x), + "Round the number @var{x} towards the nearest integer. " + "When it is exactly halfway between two integers, " + "round towards the even one.") #define FUNC_NAME s_scm_round_number { if (SCM_I_INUMP (x) || SCM_BIGP (x)) return x; else if (SCM_REALP (x)) return scm_from_double (scm_c_round (SCM_REAL_VALUE (x))); + else if (SCM_FRACTIONP (x)) + return scm_round_quotient (SCM_FRACTION_NUMERATOR (x), + SCM_FRACTION_DENOMINATOR (x)); else - { - /* OPTIMIZE-ME: Fraction case could be done more efficiently by a - single quotient+remainder division then examining to see which way - the rounding should go. */ - SCM plus_half = scm_sum (x, exactly_one_half); - SCM result = scm_floor (plus_half); - /* Adjust so that the rounding is towards even. */ - if (scm_is_true (scm_num_eq_p (plus_half, result)) - && scm_is_true (scm_odd_p (result))) - return scm_difference (result, SCM_INUM1); - else - return result; - } + SCM_WTA_DISPATCH_1 (g_scm_round_number, x, SCM_ARG1, + s_scm_round_number); } #undef FUNC_NAME @@ -8948,22 +8947,8 @@ SCM_PRIMITIVE_GENERIC (scm_floor, "floor", 1, 0, 0, else if (SCM_REALP (x)) return scm_from_double (floor (SCM_REAL_VALUE (x))); else if (SCM_FRACTIONP (x)) - { - SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x), - SCM_FRACTION_DENOMINATOR (x)); - if (scm_is_false (scm_negative_p (x))) - { - /* For positive x, rounding towards zero is correct. */ - return q; - } - else - { - /* For negative x, we need to return q-1 unless x is an - integer. But fractions are never integer, per our - assumptions. */ - return scm_difference (q, SCM_INUM1); - } - } + return scm_floor_quotient (SCM_FRACTION_NUMERATOR (x), + SCM_FRACTION_DENOMINATOR (x)); else SCM_WTA_DISPATCH_1 (g_scm_floor, x, 1, s_scm_floor); } @@ -8979,22 +8964,8 @@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ceiling", 1, 0, 0, else if (SCM_REALP (x)) return scm_from_double (ceil (SCM_REAL_VALUE (x))); else if (SCM_FRACTIONP (x)) - { - SCM q = scm_quotient (SCM_FRACTION_NUMERATOR (x), - SCM_FRACTION_DENOMINATOR (x)); - if (scm_is_false (scm_positive_p (x))) - { - /* For negative x, rounding towards zero is correct. */ - return q; - } - else - { - /* For positive x, we need to return q+1 unless x is an - integer. But fractions are never integer, per our - assumptions. */ - return scm_sum (q, SCM_INUM1); - } - } + return scm_ceiling_quotient (SCM_FRACTION_NUMERATOR (x), + SCM_FRACTION_DENOMINATOR (x)); else SCM_WTA_DISPATCH_1 (g_scm_ceiling, x, 1, s_scm_ceiling); } diff --git a/test-suite/tests/numbers.test b/test-suite/tests/numbers.test index ef59a02..1f2ee03 100644 --- a/test-suite/tests/numbers.test +++ b/test-suite/tests/numbers.test @@ -3307,6 +3307,284 @@ (= (/ 25+125i 4+3i) 19.0+17.0i)))) ;;; +;;; floor +;;; + +(with-test-prefix "floor" + (pass-if (= 1 (floor 1.75))) + (pass-if (= 1 (floor 1.5))) + (pass-if (= 1 (floor 1.25))) + (pass-if (= 0 (floor 0.75))) + (pass-if (= 0 (floor 0.5))) + (pass-if (= 0 (floor 0.0))) + (pass-if (= -1 (floor -0.5))) + (pass-if (= -2 (floor -1.25))) + (pass-if (= -2 (floor -1.5))) + + (with-test-prefix "inum" + (pass-if "0" + (and (= 0 (floor 0)) + (exact? (floor 0)))) + + (pass-if "1" + (and (= 1 (floor 1)) + (exact? (floor 1)))) + + (pass-if "-1" + (and (= -1 (floor -1)) + (exact? (floor -1))))) + + (with-test-prefix "bignum" + (let ((x (1+ most-positive-fixnum))) + (pass-if "(1+ most-positive-fixnum)" + (and (= x (floor x)) + (exact? (floor x))))) + + (let ((x (1- most-negative-fixnum))) + (pass-if "(1- most-negative-fixnum)" + (and (= x (floor x)) + (exact? (floor x)))))) + + (with-test-prefix "frac" + (define (=exact x y) + (and (= x y) + (exact? y))) + + (pass-if (=exact -3 (floor -7/3))) + (pass-if (=exact -2 (floor -5/3))) + (pass-if (=exact -2 (floor -4/3))) + (pass-if (=exact -1 (floor -2/3))) + (pass-if (=exact -1 (floor -1/3))) + (pass-if (=exact 0 (floor 1/3))) + (pass-if (=exact 0 (floor 2/3))) + (pass-if (=exact 1 (floor 4/3))) + (pass-if (=exact 1 (floor 5/3))) + (pass-if (=exact 2 (floor 7/3))) + + (pass-if (=exact -3 (floor -17/6))) + (pass-if (=exact -3 (floor -16/6))) + (pass-if (=exact -3 (floor -15/6))) + (pass-if (=exact -3 (floor -14/6))) + (pass-if (=exact -3 (floor -13/6))) + (pass-if (=exact -2 (floor -11/6))) + (pass-if (=exact -2 (floor -10/6))) + (pass-if (=exact -2 (floor -9/6))) + (pass-if (=exact -2 (floor -8/6))) + (pass-if (=exact -2 (floor -7/6))) + (pass-if (=exact -1 (floor -5/6))) + (pass-if (=exact -1 (floor -4/6))) + (pass-if (=exact -1 (floor -3/6))) + (pass-if (=exact -1 (floor -2/6))) + (pass-if (=exact -1 (floor -1/6))) + (pass-if (=exact 0 (floor 1/6))) + (pass-if (=exact 0 (floor 2/6))) + (pass-if (=exact 0 (floor 3/6))) + (pass-if (=exact 0 (floor 4/6))) + (pass-if (=exact 0 (floor 5/6))) + (pass-if (=exact 1 (floor 7/6))) + (pass-if (=exact 1 (floor 8/6))) + (pass-if (=exact 1 (floor 9/6))) + (pass-if (=exact 1 (floor 10/6))) + (pass-if (=exact 1 (floor 11/6))) + (pass-if (=exact 2 (floor 13/6))) + (pass-if (=exact 2 (floor 14/6))) + (pass-if (=exact 2 (floor 15/6))) + (pass-if (=exact 2 (floor 16/6))) + (pass-if (=exact 2 (floor 17/6)))) + + (with-test-prefix "real" + (pass-if "0.0" + (and (= 0.0 (floor 0.0)) + (inexact? (floor 0.0)))) + + (pass-if "1.0" + (and (= 1.0 (floor 1.0)) + (inexact? (floor 1.0)))) + + (pass-if "-1.0" + (and (= -1.0 (floor -1.0)) + (inexact? (floor -1.0)))) + + (pass-if "-3.1" + (and (= -4.0 (floor -3.1)) + (inexact? (floor -3.1)))) + + (pass-if "3.1" + (and (= 3.0 (floor 3.1)) + (inexact? (floor 3.1)))) + + (pass-if "3.9" + (and (= 3.0 (floor 3.9)) + (inexact? (floor 3.9)))) + + (pass-if "-3.9" + (and (= -4.0 (floor -3.9)) + (inexact? (floor -3.9)))) + + (pass-if "1.5" + (and (= 1.0 (floor 1.5)) + (inexact? (floor 1.5)))) + + (pass-if "2.5" + (and (= 2.0 (floor 2.5)) + (inexact? (floor 2.5)))) + + (pass-if "3.5" + (and (= 3.0 (floor 3.5)) + (inexact? (floor 3.5)))) + + (pass-if "-1.5" + (and (= -2.0 (floor -1.5)) + (inexact? (floor -1.5)))) + + (pass-if "-2.5" + (and (= -3.0 (floor -2.5)) + (inexact? (floor -2.5)))) + + (pass-if "-3.5" + (and (= -4.0 (floor -3.5)) + (inexact? (floor -3.5)))))) + +;;; +;;; ceiling +;;; + +(with-test-prefix "ceiling" + (pass-if (= 2 (ceiling 1.75))) + (pass-if (= 2 (ceiling 1.5))) + (pass-if (= 2 (ceiling 1.25))) + (pass-if (= 1 (ceiling 0.75))) + (pass-if (= 1 (ceiling 0.5))) + (pass-if (= 0 (ceiling 0.0))) + (pass-if (= 0 (ceiling -0.5))) + (pass-if (= -1 (ceiling -1.25))) + (pass-if (= -1 (ceiling -1.5))) + + (with-test-prefix "inum" + (pass-if "0" + (and (= 0 (ceiling 0)) + (exact? (ceiling 0)))) + + (pass-if "1" + (and (= 1 (ceiling 1)) + (exact? (ceiling 1)))) + + (pass-if "-1" + (and (= -1 (ceiling -1)) + (exact? (ceiling -1))))) + + (with-test-prefix "bignum" + (let ((x (1+ most-positive-fixnum))) + (pass-if "(1+ most-positive-fixnum)" + (and (= x (ceiling x)) + (exact? (ceiling x))))) + + (let ((x (1- most-negative-fixnum))) + (pass-if "(1- most-negative-fixnum)" + (and (= x (ceiling x)) + (exact? (ceiling x)))))) + + (with-test-prefix "frac" + (define (=exact x y) + (and (= x y) + (exact? y))) + + (pass-if (=exact -2 (ceiling -7/3))) + (pass-if (=exact -1 (ceiling -5/3))) + (pass-if (=exact -1 (ceiling -4/3))) + (pass-if (=exact 0 (ceiling -2/3))) + (pass-if (=exact 0 (ceiling -1/3))) + (pass-if (=exact 1 (ceiling 1/3))) + (pass-if (=exact 1 (ceiling 2/3))) + (pass-if (=exact 2 (ceiling 4/3))) + (pass-if (=exact 2 (ceiling 5/3))) + (pass-if (=exact 3 (ceiling 7/3))) + + (pass-if (=exact -2 (ceiling -17/6))) + (pass-if (=exact -2 (ceiling -16/6))) + (pass-if (=exact -2 (ceiling -15/6))) + (pass-if (=exact -2 (ceiling -14/6))) + (pass-if (=exact -2 (ceiling -13/6))) + (pass-if (=exact -1 (ceiling -11/6))) + (pass-if (=exact -1 (ceiling -10/6))) + (pass-if (=exact -1 (ceiling -9/6))) + (pass-if (=exact -1 (ceiling -8/6))) + (pass-if (=exact -1 (ceiling -7/6))) + (pass-if (=exact 0 (ceiling -5/6))) + (pass-if (=exact 0 (ceiling -4/6))) + (pass-if (=exact 0 (ceiling -3/6))) + (pass-if (=exact 0 (ceiling -2/6))) + (pass-if (=exact 0 (ceiling -1/6))) + (pass-if (=exact 1 (ceiling 1/6))) + (pass-if (=exact 1 (ceiling 2/6))) + (pass-if (=exact 1 (ceiling 3/6))) + (pass-if (=exact 1 (ceiling 4/6))) + (pass-if (=exact 1 (ceiling 5/6))) + (pass-if (=exact 2 (ceiling 7/6))) + (pass-if (=exact 2 (ceiling 8/6))) + (pass-if (=exact 2 (ceiling 9/6))) + (pass-if (=exact 2 (ceiling 10/6))) + (pass-if (=exact 2 (ceiling 11/6))) + (pass-if (=exact 3 (ceiling 13/6))) + (pass-if (=exact 3 (ceiling 14/6))) + (pass-if (=exact 3 (ceiling 15/6))) + (pass-if (=exact 3 (ceiling 16/6))) + (pass-if (=exact 3 (ceiling 17/6)))) + + (with-test-prefix "real" + (pass-if "0.0" + (and (= 0.0 (ceiling 0.0)) + (inexact? (ceiling 0.0)))) + + (pass-if "1.0" + (and (= 1.0 (ceiling 1.0)) + (inexact? (ceiling 1.0)))) + + (pass-if "-1.0" + (and (= -1.0 (ceiling -1.0)) + (inexact? (ceiling -1.0)))) + + (pass-if "-3.1" + (and (= -3.0 (ceiling -3.1)) + (inexact? (ceiling -3.1)))) + + (pass-if "3.1" + (and (= 4.0 (ceiling 3.1)) + (inexact? (ceiling 3.1)))) + + (pass-if "3.9" + (and (= 4.0 (ceiling 3.9)) + (inexact? (ceiling 3.9)))) + + (pass-if "-3.9" + (and (= -3.0 (ceiling -3.9)) + (inexact? (ceiling -3.9)))) + + (pass-if "1.5" + (and (= 2.0 (ceiling 1.5)) + (inexact? (ceiling 1.5)))) + + (pass-if "2.5" + (and (= 3.0 (ceiling 2.5)) + (inexact? (ceiling 2.5)))) + + (pass-if "3.5" + (and (= 4.0 (ceiling 3.5)) + (inexact? (ceiling 3.5)))) + + (pass-if "-1.5" + (and (= -1.0 (ceiling -1.5)) + (inexact? (ceiling -1.5)))) + + (pass-if "-2.5" + (and (= -2.0 (ceiling -2.5)) + (inexact? (ceiling -2.5)))) + + (pass-if "-3.5" + (and (= -3.0 (ceiling -3.5)) + (inexact? (ceiling -3.5)))))) + +;;; ;;; truncate ;;; @@ -3319,7 +3597,131 @@ (pass-if (= 0 (truncate 0.0))) (pass-if (= 0 (truncate -0.5))) (pass-if (= -1 (truncate -1.25))) - (pass-if (= -1 (truncate -1.5)))) + (pass-if (= -1 (truncate -1.5))) + + (with-test-prefix "inum" + (pass-if "0" + (and (= 0 (truncate 0)) + (exact? (truncate 0)))) + + (pass-if "1" + (and (= 1 (truncate 1)) + (exact? (truncate 1)))) + + (pass-if "-1" + (and (= -1 (truncate -1)) + (exact? (truncate -1))))) + + (with-test-prefix "bignum" + (let ((x (1+ most-positive-fixnum))) + (pass-if "(1+ most-positive-fixnum)" + (and (= x (truncate x)) + (exact? (truncate x))))) + + (let ((x (1- most-negative-fixnum))) + (pass-if "(1- most-negative-fixnum)" + (and (= x (truncate x)) + (exact? (truncate x)))))) + + (with-test-prefix "frac" + (define (=exact x y) + (and (= x y) + (exact? y))) + + (pass-if (=exact -2 (truncate -7/3))) + (pass-if (=exact -1 (truncate -5/3))) + (pass-if (=exact -1 (truncate -4/3))) + (pass-if (=exact 0 (truncate -2/3))) + (pass-if (=exact 0 (truncate -1/3))) + (pass-if (=exact 0 (truncate 1/3))) + (pass-if (=exact 0 (truncate 2/3))) + (pass-if (=exact 1 (truncate 4/3))) + (pass-if (=exact 1 (truncate 5/3))) + (pass-if (=exact 2 (truncate 7/3))) + + (pass-if (=exact -2 (truncate -17/6))) + (pass-if (=exact -2 (truncate -16/6))) + (pass-if (=exact -2 (truncate -15/6))) + (pass-if (=exact -2 (truncate -14/6))) + (pass-if (=exact -2 (truncate -13/6))) + (pass-if (=exact -1 (truncate -11/6))) + (pass-if (=exact -1 (truncate -10/6))) + (pass-if (=exact -1 (truncate -9/6))) + (pass-if (=exact -1 (truncate -8/6))) + (pass-if (=exact -1 (truncate -7/6))) + (pass-if (=exact 0 (truncate -5/6))) + (pass-if (=exact 0 (truncate -4/6))) + (pass-if (=exact 0 (truncate -3/6))) + (pass-if (=exact 0 (truncate -2/6))) + (pass-if (=exact 0 (truncate -1/6))) + (pass-if (=exact 0 (truncate 1/6))) + (pass-if (=exact 0 (truncate 2/6))) + (pass-if (=exact 0 (truncate 3/6))) + (pass-if (=exact 0 (truncate 4/6))) + (pass-if (=exact 0 (truncate 5/6))) + (pass-if (=exact 1 (truncate 7/6))) + (pass-if (=exact 1 (truncate 8/6))) + (pass-if (=exact 1 (truncate 9/6))) + (pass-if (=exact 1 (truncate 10/6))) + (pass-if (=exact 1 (truncate 11/6))) + (pass-if (=exact 2 (truncate 13/6))) + (pass-if (=exact 2 (truncate 14/6))) + (pass-if (=exact 2 (truncate 15/6))) + (pass-if (=exact 2 (truncate 16/6))) + (pass-if (=exact 2 (truncate 17/6)))) + + (with-test-prefix "real" + (pass-if "0.0" + (and (= 0.0 (truncate 0.0)) + (inexact? (truncate 0.0)))) + + (pass-if "1.0" + (and (= 1.0 (truncate 1.0)) + (inexact? (truncate 1.0)))) + + (pass-if "-1.0" + (and (= -1.0 (truncate -1.0)) + (inexact? (truncate -1.0)))) + + (pass-if "-3.1" + (and (= -3.0 (truncate -3.1)) + (inexact? (truncate -3.1)))) + + (pass-if "3.1" + (and (= 3.0 (truncate 3.1)) + (inexact? (truncate 3.1)))) + + (pass-if "3.9" + (and (= 3.0 (truncate 3.9)) + (inexact? (truncate 3.9)))) + + (pass-if "-3.9" + (and (= -3.0 (truncate -3.9)) + (inexact? (truncate -3.9)))) + + (pass-if "1.5" + (and (= 1.0 (truncate 1.5)) + (inexact? (truncate 1.5)))) + + (pass-if "2.5" + (and (= 2.0 (truncate 2.5)) + (inexact? (truncate 2.5)))) + + (pass-if "3.5" + (and (= 3.0 (truncate 3.5)) + (inexact? (truncate 3.5)))) + + (pass-if "-1.5" + (and (= -1.0 (truncate -1.5)) + (inexact? (truncate -1.5)))) + + (pass-if "-2.5" + (and (= -2.0 (truncate -2.5)) + (inexact? (truncate -2.5)))) + + (pass-if "-3.5" + (and (= -3.0 (truncate -3.5)) + (inexact? (truncate -3.5)))))) ;;; ;;; round @@ -3568,14 +3970,6 @@ (= 1.0 (exact->inexact (/ (1+ big) big)))))) ;;; -;;; floor -;;; - -;;; -;;; ceiling -;;; - -;;; ;;; expt ;;; -- 1.7.1