mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-21 11:10:21 +02:00
Code Activity

Optimize truncate, round, floor, and ceiling

Browse source 
* 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.
This commit is contained in:
Mark H Weaver 2011-02-13 07:14:57 -05:00 • committed by Andy Wingo
parent 8f9da3406b
commit 8b56bcec44
2 changed files with 432 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

412
test-suite/tests/numbers.test
View file

@ -3306,6 +3306,284 @@
(pass-if "(/ 25+125i 4+3i)"
(= (/ 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
@ -3567,14 +3969,6 @@
(let ((big (ash 1 4096)))
(= 1.0 (exact->inexact (/ (1+ big) big))))))
;;;
;;; floor
;;;
;;;
;;; ceiling
;;;
;;;
;;; expt
;;;