Permalink
Browse files

Faster branch and bound, fix some convergence in branch and cut

  • Loading branch information...
pkhuong committed Oct 7, 2012
1 parent 490c746 commit b3c9f293eeca34d995bad34ed8620cbc7704748a
@@ -3,9 +3,11 @@
:licence "BSD"
:description "Branch and cut solver for minimax polynomial approximation"
:serial t
- :depends-on ("rational-simplex" "computable-reals")
+ :depends-on ("rational-simplex" "computable-reals" "sb-concurrency"
+ "sb-md5")
:components ((:file "utility")
(:file "linf-fit")
(:file "newton")
(:file "find-extrema")
- (:file "driver")))
+ (:file "driver")
+ (:file "print-pareto")))

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -1,20 +1,40 @@
(defun make-poly (coefs &optional round)
(declare (type simple-vector coefs))
+ (when (zerop (length coefs))
+ (return-from make-poly (lambda (x) x
+ 0)))
(if round
- (let ((coefs (map '(simple-array double-float 1)
- (lambda (x)
- (float x 1d0))
- coefs)))
- (lambda (x)
- (let ((x (float x 1d0))
- (acc 0d0)
- (x^i 1d0))
- (declare (type double-float x acc x^i))
- (map nil (lambda (coef)
- (incf acc (* x^i coef))
- (setf x^i (* x x^i)))
- coefs)
- (rational acc))))
+ (ecase *float-mode*
+ (double-float
+ (let ((coefs (map '(simple-array double-float 1)
+ (lambda (x)
+ (float x 1d0))
+ coefs)))
+ (lambda (x)
+ (let ((x (float x 1d0))
+ (acc 0d0)
+ (x^i 1d0))
+ (declare (type double-float x acc x^i))
+ (map nil (lambda (coef)
+ (incf acc (* x^i coef))
+ (setf x^i (* x x^i)))
+ coefs)
+ (rational acc)))))
+ (single-float
+ (let ((coefs (map '(simple-array single-float 1)
+ (lambda (x)
+ (float x 1s0))
+ coefs)))
+ (lambda (x)
+ (let ((x (float x 1s0))
+ (acc 0s0)
+ (x^i 1s0))
+ (declare (type single-float x acc x^i))
+ (map nil (lambda (coef)
+ (incf acc (* x^i coef))
+ (setf x^i (* x x^i)))
+ coefs)
+ (rational acc))))))
(let* ((lcm (reduce #'lcm coefs :key #'denominator))
(coefs (map 'simple-vector (lambda (x)
(* x lcm))
@@ -35,6 +55,8 @@
(/ acc (ash lcm (* lb-denom (1- (length coefs))))))))))
(defun make-dpoly (coefs &optional (diff 1) round)
+ (when (> diff (length coefs))
+ (return-from make-dpoly (make-poly #() round)))
(flet ((diff (coefs)
(let ((coefs (subseq coefs 1)))
(loop for i upfrom 0
@@ -44,7 +66,7 @@
(loop repeat diff do (setf coefs (diff coefs)))
(make-poly coefs round)))
-(defun approx-error (f df d2f coefs &optional round)
+(defun poly-approx-error (f df d2f coefs &optional round)
(values (let ((f~ (make-poly coefs round)))
(lambda (x)
(computable-reals:-r (funcall f x)
@@ -71,35 +93,35 @@
(pull-bits (funcall *loc-value* x)))))
(new-root (root lb ub)
(incf roots)
- (let ((root (round-to-double root)))
+ (let ((root (round-to-float root)))
(setf maximin-distance (max maximin-distance
- (min (abs (- (double-float-bits lb)
- (double-float-bits root)))
- (abs (- (double-float-bits ub)
- (double-float-bits root))))))
- (flet ((maybe-push (x &aux (x (round-to-double x)))
+ (min (abs (- (float-bits lb)
+ (float-bits root)))
+ (abs (- (float-bits ub)
+ (float-bits root))))))
+ (flet ((maybe-push (x &aux (x (round-to-float x)))
(unless (or (<= x lb)
(>= x ub))
(setf worst-diff (max worst-diff (delta x)))
(pushnew x new-extrema))))
(maybe-push root)
- (maybe-push (double-float-from-bits
- (1+ (double-float-bits root))))
- (maybe-push (double-float-from-bits
- (1- (double-float-bits root))))))))
+ (maybe-push (float-from-bits
+ (1+ (float-bits root))))
+ (maybe-push (float-from-bits
+ (1- (float-bits root))))))))
(setf worst-diff (delta (point-loc (aref points 0))))
(loop for i from 0
for j from 1 below (length points)
for lb = (point-loc (aref points i))
for ub = (point-loc (aref points j))
do (setf worst-diff (max worst-diff (delta ub)))
- when (> (- (double-float-bits ub) (double-float-bits lb)) 1)
- do (let ((root (and (> (- (double-float-bits ub)
- (double-float-bits lb))
+ when (> (- (float-bits ub) (float-bits lb)) 1)
+ do (let ((root (and (> (- (float-bits ub)
+ (float-bits lb))
1)
(newton lb ub ddelta-f d2delta-f))))
(when root
- (new-root (round-to-double root)
+ (new-root (round-to-float root)
lb ub)))))
(values worst-diff new-extrema maximin-distance roots)))
@@ -110,6 +132,6 @@
(defun find-error-extrema (coefs points &optional round)
(multiple-value-bind (delta-f ddelta-f d2delta-f)
- (approx-error *loc-value* *loc-dvalue* *loc-d2value* coefs round)
+ (poly-approx-error *loc-value* *loc-dvalue* *loc-d2value* coefs round)
(declare (ignore delta-f))
(%approximation-error-extrema (make-poly coefs) ddelta-f d2delta-f points)))
@@ -1,10 +1,10 @@
-(declaim (type (integer 1) *dimension*))
+(declaim (type unsigned-byte *dimension*))
(defvar *dimension* 6)
(defun powers (x &optional (degree (1- *dimension*)))
- (let ((x (float x 1d0)))
+ (let ((x (floatify x)))
(coerce (loop for i upto degree
- collect (round-to-double (expt x i)))
+ collect (round-to-float (expt x i)))
'simple-vector)))
(defvar *loc-parameters* 'powers)
@@ -9,8 +9,8 @@
(defun initial-newton (lo hi f df)
(declare (optimize debug))
(let* ((*precision* 64)
- (lo (round-to-double lo))
- (hi (round-to-double hi))
+ (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)))
@@ -49,8 +49,8 @@
(return lo))
((zerop shi)
(return hi))
- ((<= (abs (- (double-float-bits lo)
- (double-float-bits hi)))
+ ((<= (abs (- (float-bits lo)
+ (float-bits hi)))
1)
(return x)))
(loop for i upfrom 1 do
@@ -77,13 +77,13 @@
(setf x (if newtonp
(pull-bits x2)
(/ (+ lo hi) 2)))
- (when (<= (abs (- (double-float-bits lo)
- (double-float-bits hi)))
+ (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-double lo) (round-to-double hi) f df)
+ (initial-newton (round-to-float lo) (round-to-float hi) f df)
(and lo hi
(bracketed-newton lo hi f df))))
Oops, something went wrong.

0 comments on commit b3c9f29

Please sign in to comment.