diff options
author | Thomas Bushnell, BSG <tb@debian.org> | 2006-10-23 23:55:08 -0700 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:37 -0800 |
commit | 97fc07b2d8896b869db55827900f24e6528a9bd6 (patch) | |
tree | 262ed5c19ad83dd59aac33d2e04ace4fbd94bd3b /root.scm | |
parent | 810b08c931e958fdaa6971b2ce8c5e578130d652 (diff) | |
parent | 5bea21e81ed516440e34e480f2c33ca41aa8c597 (diff) | |
download | slib-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.scm | 37 |
1 files changed, 23 insertions, 14 deletions
@@ -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) |