Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 90 lines (86 sloc) 2.948 kB
490c746 @pkhuong Demo: branch-and-cut and branch-and-bound for float polynomials
authored
1 (defun one-newton-step (x f df)
2 (let* ((fx (pull-bits (funcall f x)))
3 (dfx (pull-bits (funcall df x))))
4 (values (and (/= dfx 0)
5 (pull-bits (- x (/ fx dfx))))
6 fx x)))
7
8 ;; try to bracket a root of f.
9 (defun initial-newton (lo hi f df)
10 (declare (optimize debug))
11 (let* ((*precision* 64)
b3c9f29 @pkhuong Faster branch and bound, fix some convergence in branch and cut
authored
12 (lo (round-to-float lo))
13 (hi (round-to-float hi))
490c746 @pkhuong Demo: branch-and-cut and branch-and-bound for float polynomials
authored
14 (slo (signum (pull-bits (funcall f lo))))
15 (shi (signum (pull-bits (funcall f hi))))
16 (x (/ (+ lo hi) 2)))
17 (block nil
18 (cond ((zerop slo)
19 (return (values lo lo)))
20 ((zerop shi)
21 (return (values hi hi)))
22 ((/= slo shi)
23 (return (values lo hi))))
24 (loop repeat 32 do
25 (multiple-value-bind (x2 fx)
26 (one-newton-step (pull-bits x) f df)
27 (cond ((/= (signum fx) slo)
28 (return
29 (if (and x2 (< x2 x))
30 (values lo x)
31 (values x hi))))
32 ((not x2)
33 (return))
34 ((>= x2 hi)
35 (return))
36 ((<= x2 lo)
37 (return))
38 (t (setf x x2))))))))
39
40 (defun bracketed-newton (lo hi f df)
41 (let* ((*precision* 64)
42 (lo (pull-bits lo))
43 (hi (pull-bits hi))
44 (slo (signum (pull-bits (funcall f lo))))
45 (shi (signum (pull-bits (funcall f hi))))
46 (x (/ (+ lo hi) 2)))
47 (block nil
48 (cond ((zerop slo)
49 (return lo))
50 ((zerop shi)
51 (return hi))
b3c9f29 @pkhuong Faster branch and bound, fix some convergence in branch and cut
authored
52 ((<= (abs (- (float-bits lo)
53 (float-bits hi)))
490c746 @pkhuong Demo: branch-and-cut and branch-and-bound for float polynomials
authored
54 1)
55 (return x)))
56 (loop for i upfrom 1 do
57 (let ((*precision* (min (max (ash 1 i) 64)
58 1024))
59 (newtonp t))
60 (multiple-value-bind (x2 fx)
61 (and (plusp (mod i 3))
62 (one-newton-step (pull-bits x) f df))
63 (when (or (not x2)
64 (>= x2 (max hi lo))
65 (<= x2 (min hi lo)))
66 (setf newtonp nil
67 x (/ (+ lo hi) 2)
68 x2 x
69 fx (pull-bits (funcall f x))))
70 (when (zerop fx)
71 (return x))
72 (let ((sx (signum fx)))
73 (cond ((= sx shi)
74 (setf hi x))
75 ((= sx slo)
76 (setf lo x))))
77 (setf x (if newtonp
78 (pull-bits x2)
79 (/ (+ lo hi) 2)))
b3c9f29 @pkhuong Faster branch and bound, fix some convergence in branch and cut
authored
80 (when (<= (abs (- (float-bits lo)
81 (float-bits hi)))
490c746 @pkhuong Demo: branch-and-cut and branch-and-bound for float polynomials
authored
82 1)
83 (return x))))))))
84
85 (defun newton (lo hi f df)
86 (multiple-value-bind (lo hi)
b3c9f29 @pkhuong Faster branch and bound, fix some convergence in branch and cut
authored
87 (initial-newton (round-to-float lo) (round-to-float hi) f df)
490c746 @pkhuong Demo: branch-and-cut and branch-and-bound for float polynomials
authored
88 (and lo hi
89 (bracketed-newton lo hi f df))))
Something went wrong with that request. Please try again.