Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

90 lines (86 sloc) 2.948 kB
(defun one-newton-step (x f df)
(let* ((fx (pull-bits (funcall f x)))
(dfx (pull-bits (funcall df x))))
(values (and (/= dfx 0)
(pull-bits (- x (/ fx dfx))))
fx x)))
;; try to bracket a root of f.
(defun initial-newton (lo hi f df)
(declare (optimize debug))
(let* ((*precision* 64)
(lo (round-to-float lo))
(hi (round-to-float hi))
(slo (signum (pull-bits (funcall f lo))))
(shi (signum (pull-bits (funcall f hi))))
(x (/ (+ lo hi) 2)))
(block nil
(cond ((zerop slo)
(return (values lo lo)))
((zerop shi)
(return (values hi hi)))
((/= slo shi)
(return (values lo hi))))
(loop repeat 32 do
(multiple-value-bind (x2 fx)
(one-newton-step (pull-bits x) f df)
(cond ((/= (signum fx) slo)
(return
(if (and x2 (< x2 x))
(values lo x)
(values x hi))))
((not x2)
(return))
((>= x2 hi)
(return))
((<= x2 lo)
(return))
(t (setf x x2))))))))
(defun bracketed-newton (lo hi f df)
(let* ((*precision* 64)
(lo (pull-bits lo))
(hi (pull-bits hi))
(slo (signum (pull-bits (funcall f lo))))
(shi (signum (pull-bits (funcall f hi))))
(x (/ (+ lo hi) 2)))
(block nil
(cond ((zerop slo)
(return lo))
((zerop shi)
(return hi))
((<= (abs (- (float-bits lo)
(float-bits hi)))
1)
(return x)))
(loop for i upfrom 1 do
(let ((*precision* (min (max (ash 1 i) 64)
1024))
(newtonp t))
(multiple-value-bind (x2 fx)
(and (plusp (mod i 3))
(one-newton-step (pull-bits x) f df))
(when (or (not x2)
(>= x2 (max hi lo))
(<= x2 (min hi lo)))
(setf newtonp nil
x (/ (+ lo hi) 2)
x2 x
fx (pull-bits (funcall f x))))
(when (zerop fx)
(return x))
(let ((sx (signum fx)))
(cond ((= sx shi)
(setf hi x))
((= sx slo)
(setf lo x))))
(setf x (if newtonp
(pull-bits x2)
(/ (+ lo hi) 2)))
(when (<= (abs (- (float-bits lo)
(float-bits hi)))
1)
(return x))))))))
(defun newton (lo hi f df)
(multiple-value-bind (lo hi)
(initial-newton (round-to-float lo) (round-to-float hi) f df)
(and lo hi
(bracketed-newton lo hi f df))))
Jump to Line
Something went wrong with that request. Please try again.