aboutsummaryrefslogtreecommitdiffstats
path: root/math-integer.scm
diff options
context:
space:
mode:
Diffstat (limited to 'math-integer.scm')
-rwxr-xr-x[-rw-r--r--]math-integer.scm20
1 files changed, 18 insertions, 2 deletions
diff --git a/math-integer.scm b/math-integer.scm
index 1ce70f8..2a1572a 100644..100755
--- a/math-integer.scm
+++ b/math-integer.scm
@@ -1,5 +1,5 @@
; "math-integer.scm": mathematical functions restricted to exact integers
-; Copyright (C) 2006 Aubrey Jaffer
+; Copyright (C) 2006, 2013 Aubrey Jaffer
;
;Permission to copy this software, to modify it, to redistribute it,
;to distribute modified versions, and to use it for any purpose is
@@ -95,8 +95,24 @@
(not (zero? n2)))
(proc n1 n2)
(slib:error name n1 n2))))
-;;@body
+;;@args n1 n2
+;;@defunx remainder n1 n2
+;;@defunx modulo n1 n2
;;are redefined so that they accept only exact-integer arguments.
(define quotient (must-be-exact-integer2 'quotient quotient))
(define remainder (must-be-exact-integer2 'remainder remainder))
(define modulo (must-be-exact-integer2 'modulo modulo))
+
+;;@args n1 n2
+;;Returns the quotient of @1 and @2 rounded toward even.
+;;
+;;@example
+;;(quotient 3 2) @result{} 1
+;;(round-quotient 3 2) @result{} 2
+;;@end example
+(define (round-quotient num den)
+ (define quo (quotient num den))
+ (define rem (remainder num den))
+ (if ((if (even? quo) > >=) (abs (* 2 rem)) (abs den))
+ (+ quo (if (eq? (negative? num) (negative? den)) 1 -1))
+ quo))