Commit 20075975 authored by pfdietz's avatar pfdietz

Slight fixup on sqrt.17 to take into account rounding problems if fixnums can...

Slight fixup on sqrt.17 to take into account rounding problems if fixnums can be large, as they can on 64 bit lisps.  Thanks to jsnell for finding the problem
parent a632f885
......@@ -31,6 +31,35 @@
(return hi)
(setq lo mid))))))
(defun integer-binary-search (fn lo hi)
"FN is a function that, if true for X, is true for all Y < X.
Find the largest integer in [lo,hi) for which the function
return true."
(assert (functionp fn))
(assert (integerp lo))
(assert (integerp hi))
(assert (<= lo hi))
(assert (funcall fn lo))
(loop while (< lo hi)
do (let ((mid (ceiling (+ lo hi) 2)))
(if (funcall fn mid)
(setq lo mid)
(if (= mid hi)
(return lo)
(setq hi mid))))))
(defun find-largest-exactly-floatable-integer (upper-bound)
(integer-binary-search
#'(lambda (i)
(let* ((f (float i))
(i- (1- i))
(f- (float i-)))
(and (= f i) (= f- i-))))
0 upper-bound))
(defun eqlzt (x y)
"Return T if (eql x y) or if both are zero of the same type."
(cond
......
......@@ -184,10 +184,11 @@
nil)
(deftest sqrt.17
(loop for i = (random-from-interval most-positive-fixnum 0)
repeat 1000
unless (>= (sqrt i) (isqrt i))
collect i)
(let ((b1 (find-largest-exactly-floatable-integer (* most-positive-fixnum most-positive-fixnum))))
(loop for i = (random-from-interval (* b1 b1) 0)
repeat 1000
unless (>= (sqrt i) (isqrt i))
collect i))
nil)
(deftest sqrt.18
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment