Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-04 19:56:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding division tests and putting (scheme division) in the public domain

Browse source
This commit is contained in:
Alex Shinn 2011-11-28 08:37:06 +09:00
parent 9ea9a4d26a
commit 5f63567db0
2 changed files with 403 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
lib/scheme/division.scm
View file

@ -1,3 +1,19 @@
;;;; division.scm -- portable R7RS (scheme division) implementation
;;
;; This code is written by Alex Shinn and placed in the
;; Public Domain. All warranties are disclaimed.
;;
;; This is basically the simplest possible implementation. Note the
;; code below assumes that either 1) exact ratios are supported and
;; are handled correctly by floor, ceiling and round, or 2) that
;; you're using a simple implementation with only fixnums and flonums.
;; In the intermediate case where you have bignums but no ratios there
;; will be a loss of precision for large values.
;;
;; In case 1) the calls to inexact->exact below are unecessary and can
;; be removed.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The builtin quotient and remainder implement truncation - the
;; fractional part is always discarded.

387
tests/division-tests.scm Normal file
View file

@ -0,0 +1,387 @@
(import (chibi test) (scheme division))
(test-begin "division")
;; These verify the basic rounding operators floor, ceiling, truncate
;; and round, on which the other tests depend.
(test-begin "rounding")
(test 4.0 (floor 4.3))
(test 5.0 (ceiling 4.3))
(test 4.0 (truncate 4.3))
(test 4.0 (round 4.3))
(test -5.0 (floor -4.3))
(test -4.0 (ceiling -4.3))
(test -4.0 (truncate -4.3))
(test -4.0 (round -4.3))
(test 3.0 (floor 3.5))
(test 4.0 (ceiling 3.5))
(test 3.0 (truncate 3.5))
(test 4.0 (round 3.5))
(test -4.0 (floor -3.5))
(test -3.0 (ceiling -3.5))
(test -3.0 (truncate -3.5))
(test -4.0 (round -3.5))
(test 3 (floor (/ 1300000000000000000000 400000000000000000000)))
(test 4 (ceiling (/ 1300000000000000000000 400000000000000000000)))
(test 3 (truncate (/ 1300000000000000000000 400000000000000000000)))
(test 3 (round (/ 1300000000000000000000 400000000000000000000)))
(test -4 (floor (/ -1300000000000000000000 400000000000000000000)))
(test -3 (ceiling (/ -1300000000000000000000 400000000000000000000)))
(test -3 (truncate (/ -1300000000000000000000 400000000000000000000)))
(test -3 (round (/ -1300000000000000000000 400000000000000000000)))
(test 650000000000000000000 (floor (/ 1300000000000000000001 2)))
(test 650000000000000000001 (ceiling (/ 1300000000000000000001 2)))
(test 650000000000000000000 (truncate (/ 1300000000000000000001 2)))
(test 650000000000000000000 (round (/ 1300000000000000000001 2)))
(test 650000000000000000001 (floor (/ 1300000000000000000003 2)))
(test 650000000000000000002 (ceiling (/ 1300000000000000000003 2)))
(test 650000000000000000001 (truncate (/ 1300000000000000000003 2)))
(test 650000000000000000002 (round (/ 1300000000000000000003 2)))
(test -650000000000000000001 (floor (/ -1300000000000000000001 2)))
(test -650000000000000000000 (ceiling (/ -1300000000000000000001 2)))
(test -650000000000000000000 (truncate (/ -1300000000000000000001 2)))
(test -650000000000000000000 (round (/ -1300000000000000000001 2)))
(test -650000000000000000002 (floor (/ -1300000000000000000003 2)))
(test -650000000000000000001 (ceiling (/ -1300000000000000000003 2)))
(test -650000000000000000001 (truncate (/ -1300000000000000000003 2)))
(test -650000000000000000002 (round (/ -1300000000000000000003 2)))
(test 4 (round 7/2))
(test 7 (round 7))
(test-end)
(test-begin "trivial zero divisor")
;; All operators are the same when the quotient is zero.
(test 0 (ceiling-quotient 0 4))
(test 0 (ceiling-quotient 0 -4))
(test 0 (ceiling-remainder 0 4))
(test 0 (ceiling-remainder 0 -4))
(test 0 (floor-quotient 0 4))
(test 0 (floor-quotient 0 -4))
(test 0 (floor-remainder 0 4))
(test 0 (floor-remainder 0 -4))
(test 0 (truncate-quotient 0 4))
(test 0 (truncate-quotient 0 -4))
(test 0 (truncate-remainder 0 4))
(test 0 (truncate-remainder 0 -4))
(test 0 (round-quotient 0 4))
(test 0 (round-quotient 0 -4))
(test 0 (round-remainder 0 4))
(test 0 (round-remainder 0 -4))
(test 0 (euclidean-quotient 0 4))
(test 0 (euclidean-quotient 0 -4))
(test 0 (euclidean-remainder 0 4))
(test 0 (euclidean-remainder 0 -4))
(test 0 (centered-quotient 0 4))
(test 0 (centered-quotient 0 -4))
(test 0 (centered-remainder 0 4))
(test 0 (centered-remainder 0 -4))
(test-end)
(test-begin "trivial one dividend")
;; The remainder is always zero when dividing by one.
(test 13 (ceiling-quotient 13 1))
(test -13 (ceiling-quotient -13 1))
(test 0 (ceiling-remainder 13 1))
(test 0 (ceiling-remainder -13 1))
(test 13 (floor-quotient 13 1))
(test -13 (floor-quotient -13 1))
(test 0 (floor-remainder 13 1))
(test 0 (floor-remainder -13 1))
(test 13 (truncate-quotient 13 1))
(test -13 (truncate-quotient -13 1))
(test 0 (truncate-remainder 13 1))
(test 0 (truncate-remainder -13 1))
(test 13 (round-quotient 13 1))
(test -13 (round-quotient -13 1))
(test 0 (round-remainder 13 1))
(test 0 (round-remainder -13 1))
(test 13 (euclidean-quotient 13 1))
(test -13 (euclidean-quotient -13 1))
(test 0 (euclidean-remainder 13 1))
(test 0 (euclidean-remainder -13 1))
(test 13 (centered-quotient 13 1))
(test -13 (centered-quotient -13 1))
(test 0 (centered-remainder 13 1))
(test 0 (centered-remainder -13 1))
(test-end)
(test-begin "fixnum division")
;; Ceiling rounds towards positive infinity.
(test 4 (ceiling-quotient 13 4))
(test -3 (ceiling-quotient -13 4))
(test -3 (ceiling-quotient 13 -4))
(test 4 (ceiling-quotient -13 -4))
(test -3 (ceiling-remainder 13 4))
(test -1 (ceiling-remainder -13 4))
(test 1 (ceiling-remainder 13 -4))
(test 3 (ceiling-remainder -13 -4))
;; Floor rounds towards negative infinity.
(test 3 (floor-quotient 13 4))
(test -4 (floor-quotient -13 4))
(test -4 (floor-quotient 13 -4))
(test 3 (floor-quotient -13 -4))
(test 1 (floor-remainder 13 4))
(test 3 (floor-remainder -13 4))
(test -3 (floor-remainder 13 -4))
(test -1 (floor-remainder -13 -4))
;; Truncate rounds towards zero - the magnitudes never change
;; regardless of the signs.
(test 3 (truncate-quotient 13 4))
(test -3 (truncate-quotient -13 4))
(test -3 (truncate-quotient 13 -4))
(test 3 (truncate-quotient -13 -4))
(test 1 (truncate-remainder 13 4))
(test -1 (truncate-remainder -13 4))
(test 1 (truncate-remainder 13 -4))
(test -1 (truncate-remainder -13 -4))
;; Round rounds towards the nearest integer - it's equivalent to floor
;; when signs are the same, and equivalent to ceiling when the signs
;; differ.
(test 3 (round-quotient 13 4))
(test -3 (round-quotient -13 4))
(test -3 (round-quotient 13 -4))
(test 3 (round-quotient -13 -4))
(test 1 (round-remainder 13 4))
(test -1 (round-remainder -13 4))
(test 1 (round-remainder 13 -4))
(test -1 (round-remainder -13 -4))
;; Euclidean rounds such that the remainder is always in the interval
;; [0, divisor) - i.e. the remainder is always non-negative. It's
;; equivalent to floor if the divisor is negative, and ceiling
;; otherwise.
(test 3 (euclidean-quotient 13 4))
(test -4 (euclidean-quotient -13 4))
(test -3 (euclidean-quotient 13 -4))
(test 4 (euclidean-quotient -13 -4))
(test 1 (euclidean-remainder 13 4))
(test 3 (euclidean-remainder -13 4))
(test 1 (euclidean-remainder 13 -4))
(test 3 (euclidean-remainder -13 -4))
;; Centered differs from truncate only in the 0.5 remainder border
;; case in the next test group.
(test 3 (centered-quotient 13 4))
(test -3 (centered-quotient -13 4))
(test -3 (centered-quotient 13 -4))
(test 3 (centered-quotient -13 -4))
(test 1 (centered-remainder 13 4))
(test -1 (centered-remainder -13 4))
(test 1 (centered-remainder 13 -4))
(test -1 (centered-remainder -13 -4))
(test-end)
(test-begin "one half remainder")
;; Testing the 0.5 remainder border cases. Ceiling, floor and
;; truncate and euclidean don't change.
(test 7 (ceiling-quotient 13 2))
(test -6 (ceiling-quotient -13 2))
(test -6 (ceiling-quotient 13 -2))
(test 7 (ceiling-quotient -13 -2))
(test -1 (ceiling-remainder 13 2))
(test -1 (ceiling-remainder -13 2))
(test 1 (ceiling-remainder 13 -2))
(test 1 (ceiling-remainder -13 -2))
(test 6 (floor-quotient 13 2))
(test -7 (floor-quotient -13 2))
(test -7 (floor-quotient 13 -2))
(test 6 (floor-quotient -13 -2))
(test 1 (floor-remainder 13 2))
(test 1 (floor-remainder -13 2))
(test -1 (floor-remainder 13 -2))
(test -1 (floor-remainder -13 -2))
(test 6 (truncate-quotient 13 2))
(test -6 (truncate-quotient -13 2))
(test -6 (truncate-quotient 13 -2))
(test 6 (truncate-quotient -13 -2))
(test 1 (truncate-remainder 13 2))
(test -1 (truncate-remainder -13 2))
(test 1 (truncate-remainder 13 -2))
(test -1 (truncate-remainder -13 -2))
(test 6 (euclidean-quotient 13 2))
(test -7 (euclidean-quotient -13 2))
(test -6 (euclidean-quotient 13 -2))
(test 7 (euclidean-quotient -13 -2))
(test 1 (euclidean-remainder 13 2))
(test 1 (euclidean-remainder -13 2))
(test 1 (euclidean-remainder 13 -2))
(test 1 (euclidean-remainder -13 -2))
;; For consistency with the default rounding mode specified by the
;; IEEE floating point standard, round rounds to even when exactly
;; half-way between two integers.
(test 6 (round-quotient 13 2))
(test -6 (round-quotient -13 2))
(test -6 (round-quotient 13 -2))
(test 6 (round-quotient -13 -2))
(test 1 (round-remainder 13 2))
(test -1 (round-remainder -13 2))
(test 1 (round-remainder 13 -2))
(test -1 (round-remainder -13 -2))
;; Centered rounds up when exactly half-way between two integers.
(test 7 (centered-quotient 13 2))
(test -6 (centered-quotient -13 2))
(test -7 (centered-quotient 13 -2))
(test 6 (centered-quotient -13 -2))
(test -1 (centered-remainder 13 2))
(test -1 (centered-remainder -13 2))
(test -1 (centered-remainder 13 -2))
(test -1 (centered-remainder -13 -2))
(test-end)
(test-begin "bignum division")
;; A repeat of the fixnum division tests above, using bignums to test
;; bignum division.
(test 4 (ceiling-quotient 1300000000000000000000 400000000000000000000))
(test -3 (ceiling-quotient -1300000000000000000000 400000000000000000000))
(test -3 (ceiling-quotient 1300000000000000000000 -400000000000000000000))
(test 4 (ceiling-quotient -1300000000000000000000 -400000000000000000000))
(test -300000000000000000000
(ceiling-remainder 1300000000000000000000 400000000000000000000))
(test -100000000000000000000
(ceiling-remainder -1300000000000000000000 400000000000000000000))
(test 100000000000000000000
(ceiling-remainder 1300000000000000000000 -400000000000000000000))
(test 300000000000000000000
(ceiling-remainder -1300000000000000000000 -400000000000000000000))
(test 3 (floor-quotient 1300000000000000000000 400000000000000000000))
(test -4 (floor-quotient -1300000000000000000000 400000000000000000000))
(test -4 (floor-quotient 1300000000000000000000 -400000000000000000000))
(test 3 (floor-quotient -1300000000000000000000 -400000000000000000000))
(test 100000000000000000000
(floor-remainder 1300000000000000000000 400000000000000000000))
(test 300000000000000000000
(floor-remainder -1300000000000000000000 400000000000000000000))
(test -300000000000000000000
(floor-remainder 1300000000000000000000 -400000000000000000000))
(test -100000000000000000000
(floor-remainder -1300000000000000000000 -400000000000000000000))
(test 3 (truncate-quotient 1300000000000000000000 400000000000000000000))
(test -3 (truncate-quotient -1300000000000000000000 400000000000000000000))
(test -3 (truncate-quotient 1300000000000000000000 -400000000000000000000))
(test 3 (truncate-quotient -1300000000000000000000 -400000000000000000000))
(test 100000000000000000000
(truncate-remainder 1300000000000000000000 400000000000000000000))
(test -100000000000000000000
(truncate-remainder -1300000000000000000000 400000000000000000000))
(test 100000000000000000000
(truncate-remainder 1300000000000000000000 -400000000000000000000))
(test -100000000000000000000
(truncate-remainder -1300000000000000000000 -400000000000000000000))
(test 3 (round-quotient 1300000000000000000000 400000000000000000000))
(test -3 (round-quotient -1300000000000000000000 400000000000000000000))
(test -3 (round-quotient 1300000000000000000000 -400000000000000000000))
(test 3 (round-quotient -1300000000000000000000 -400000000000000000000))
(test 100000000000000000000
(round-remainder 1300000000000000000000 400000000000000000000))
(test -100000000000000000000
(round-remainder -1300000000000000000000 400000000000000000000))
(test 100000000000000000000
(round-remainder 1300000000000000000000 -400000000000000000000))
(test -100000000000000000000
(round-remainder -1300000000000000000000 -400000000000000000000))
(test 3 (euclidean-quotient 1300000000000000000000 400000000000000000000))
(test -4 (euclidean-quotient -1300000000000000000000 400000000000000000000))
(test -3 (euclidean-quotient 1300000000000000000000 -400000000000000000000))
(test 4 (euclidean-quotient -1300000000000000000000 -400000000000000000000))
(test 100000000000000000000
(euclidean-remainder 1300000000000000000000 400000000000000000000))
(test 300000000000000000000
(euclidean-remainder -1300000000000000000000 400000000000000000000))
(test 100000000000000000000
(euclidean-remainder 1300000000000000000000 -400000000000000000000))
(test 300000000000000000000
(euclidean-remainder -1300000000000000000000 -400000000000000000000))
(test 3 (centered-quotient 1300000000000000000000 400000000000000000000))
(test -3 (centered-quotient -1300000000000000000000 400000000000000000000))
(test -3 (centered-quotient 1300000000000000000000 -400000000000000000000))
(test 3 (centered-quotient -1300000000000000000000 -400000000000000000000))
(test 100000000000000000000
(centered-remainder 1300000000000000000000 400000000000000000000))
(test -100000000000000000000
(centered-remainder -1300000000000000000000 400000000000000000000))
(test 100000000000000000000
(centered-remainder 1300000000000000000000 -400000000000000000000))
(test -100000000000000000000
(centered-remainder -1300000000000000000000 -400000000000000000000))
(test-end)
(test-end)