Changeset 3557

Timestamp:

09/02/03 17:50:32 (20 years ago)

Author:

piso

Message:

ISQRT

Location:

trunk/j/src/org/armedbear/lisp

Files:

• autoloads.lisp (modified) (2 diffs)
• numbers.lisp (modified) (2 diffs)

trunk/j/src/org/armedbear/lisp/autoloads.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: autoloads.lisp,v 1.13 2003-09-02 16:15:56 piso Exp $
+;;; $Id: autoloads.lisp,v 1.14 2003-09-02 17:50:32 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -74 +74 @@
 (autoload 'make-pathname)
 (autoload '(floor ceiling round rem mod ftruncate ffloor fceiling fround
-            rational rationalize)
+            rational rationalize isqrt)
           "numbers.lisp")

trunk/j/src/org/armedbear/lisp/numbers.lisp

@@ -2 +2 @@
 ;;;
 ;;; Copyright (C) 2003 Peter Graves
-;;; $Id: numbers.lisp,v 1.8 2003-09-02 16:15:20 piso Exp $
+;;; $Id: numbers.lisp,v 1.9 2003-09-02 17:49:54 piso Exp $
 ;;;
 ;;; This program is free software; you can redistribute it and/or
@@ -163 +163 @@
                                rational
                                rationalize)))
+
+
+
+;;; From discussion on comp.lang.lisp and Akira Kurihara.
+(defun isqrt (n)
+  "Returns the root of the nearest integer less than n which is a perfect
+   square."
+  (declare (type unsigned-byte n) (values unsigned-byte))
+  ;; theoretically (> n 7) ,i.e., n-len-quarter > 0
+  (if (and (fixnump n) (<= n 24))
+      (cond ((> n 15) 4)
+      ((> n  8) 3)
+      ((> n  3) 2)
+      ((> n  0) 1)
+      (t 0))
+      (let* ((n-len-quarter (ash (integer-length n) -2))
+       (n-half (ash n (- (ash n-len-quarter 1))))
+       (n-half-isqrt (isqrt n-half))
+       (init-value (ash (1+ n-half-isqrt) n-len-quarter)))
+  (loop
+    (let ((iterated-value
+     (ash (+ init-value (truncate n init-value)) -1)))
+      (unless (< iterated-value init-value)
+        (return init-value))
+      (setq init-value iterated-value))))))