diff options
author | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:34 -0800 |
---|---|---|
committer | Bryan Newbold <bnewbold@robocracy.org> | 2017-02-20 00:05:34 -0800 |
commit | 237c6e380aebdcbc70bd1c9ecf7d3f6effca2752 (patch) | |
tree | 9832fbdd6fbeedf3fc7f0e7923fe20b7d35b1499 /root.scm | |
parent | 5145dd3aa0c02c9fc496d1432fc4410674206e1d (diff) | |
download | slib-237c6e380aebdcbc70bd1c9ecf7d3f6effca2752.tar.gz slib-237c6e380aebdcbc70bd1c9ecf7d3f6effca2752.zip |
Import Upstream version 3a3upstream/3a3
Diffstat (limited to 'root.scm')
-rw-r--r-- | root.scm | 28 |
1 files changed, 24 insertions, 4 deletions
@@ -40,11 +40,31 @@ (next-fx (f next-x))) (cond ((>= (abs next-fx) (abs fx)) x) (else (loop next-x next-fx))))))))))) + +;;(define (integer-sqrt y) +;; (newton:find-integer-root (lambda (x) (- (* x x) y)) +;; (lambda (x) (* 2 x)) +;; (ash 1 (quotient (integer-length y) 2)))) + +;;;; http://www.cs.cmu.edu/afs/cs/project/ai-repository/ai/lang/lisp/code/math/isqrt/isqrt.txt +;;; Akira Kurihara +;;; School of Mathematics +;;; Japan Women's University ;@ -(define (integer-sqrt y) - (newton:find-integer-root (lambda (x) (- (* x x) y)) - (lambda (x) (* 2 x)) - (ash 1 (quotient (integer-length y) 2)))) +(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 (newton:find-root f df/dx x_0 prec) (if (and (negative? prec) (integer? prec)) |