diff options
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) |