summaryrefslogtreecommitdiffstats
path: root/root.scm
diff options
context:
space:
mode:
authorThomas Bushnell, BSG <tb@debian.org>2006-10-23 23:55:08 -0700
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:37 -0800
commit97fc07b2d8896b869db55827900f24e6528a9bd6 (patch)
tree262ed5c19ad83dd59aac33d2e04ace4fbd94bd3b /root.scm
parent810b08c931e958fdaa6971b2ce8c5e578130d652 (diff)
parent5bea21e81ed516440e34e480f2c33ca41aa8c597 (diff)
downloadslib-97fc07b2d8896b869db55827900f24e6528a9bd6.tar.gz
slib-97fc07b2d8896b869db55827900f24e6528a9bd6.zip
Import Debian changes 3a4-1debian/3a4-1
slib (3a4-1) unstable; urgency=low * New upstream release. * slib.texi (Library Catalogs): Repeat change from 3a3-3. * Makefile: Repeat $(htmldir)slib_toc.html changes from 3a2-1.
Diffstat (limited to 'root.scm')
-rw-r--r--root.scm37
1 files changed, 23 insertions, 14 deletions
diff --git a/root.scm b/root.scm
index 3cfdc19..7045e54 100644
--- a/root.scm
+++ b/root.scm
@@ -51,19 +51,28 @@
;;; School of Mathematics
;;; Japan Women's University
;@
-(define (integer-sqrt n)
- (cond ((> n 24) (let* ((length/4 (quotient (- (integer-length n) 1) 4))
- (sqrt-top (integer-sqrt (ash n (* -2 length/4))))
- (init-value (ash sqrt-top length/4))
- (q (quotient n init-value))
- (iterated-value (quotient (+ init-value q) 2)))
- (if (odd? q) iterated-value
- (let ((m (- iterated-value init-value)))
- (if (< (remainder n init-value) (* m m))
- (- iterated-value 1)
- iterated-value)))))
- ((> n 15) 4) ((> n 8) 3) ((> n 3) 2) ((> n 0) 1) ((> n -1) 0)
- (else (slib:error 'integer-sqrt n))))
+(define integer-sqrt
+ (let ((table '#(0
+ 1 1 1
+ 2 2 2 2 2
+ 3 3 3 3 3 3 3
+ 4 4 4 4 4 4 4 4 4))
+ (square (lambda (x) (* x x))))
+ (lambda (n)
+ (define (isqrt n)
+ (if (> n 24)
+ (let* ((len/4 (quotient (- (integer-length n) 1) 4))
+ (top (isqrt (ash n (* -2 len/4))))
+ (init (ash top len/4))
+ (q (quotient n init))
+ (iter (quotient (+ init q) 2)))
+ (cond ((odd? q) iter)
+ ((< (remainder n init) (square (- iter init))) (- iter 1))
+ (else iter)))
+ (vector-ref table n)))
+ (if (and (exact? n) (integer? n) (not (negative? n)))
+ (isqrt n)
+ (type-error 'integer-sqrt n)))))
;@
(define (newton:find-root f df/dx x_0 prec)
@@ -174,7 +183,7 @@
(letrec ((stop?
(cond ((procedure? prec) prec)
((and (integer? prec) (negative? prec))
- (lambda (x0 x1 fmax count)
+ (lambda (x0 f0 x1 f1 count)
(>= count (- prec))))
(else
(lambda (x0 f0 x1 f1 count)