Commit a2ba427b authored by Liam Healy's avatar Liam Healy

Fix multidimensional minimization with scalarsp

In the definition of multi-dimensional-minimizer-fdf, the dimensions
of the :output for df and fdf have been corrected by removing an extra
dim0.  The parabaloid example has been implemented using scalars, and
the results match that of the vector form.  A test has been added for
the scalar form.
parent d19cc672
;; Multivariate minimization. ;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28> ;; Liam Healy <Tue Jan 8 2008 - 21:28>
;; Time-stamp: <2009-05-25 10:04:32EDT minimization-multi.lisp> ;; Time-stamp: <2009-06-09 23:02:27EDT minimization-multi.lisp>
;; $Id$ ;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -66,11 +66,11 @@ ...@@ -66,11 +66,11 @@
(function :double (:input :double :marray dim0) :slug) (function :double (:input :double :marray dim0) :slug)
(df :void (df :void
(:input :double :marray dim0) :slug (:input :double :marray dim0) :slug
(:output :double :marray dim0 dim0)) (:output :double :marray dim0))
(fdf :void (fdf :void
(:input :double :marray dim0) :slug (:input :double :marray dim0) :slug
(:output :double :cvector dim0) (:output :double :cvector 1)
(:output :double :marray dim0 dim0))) (:output :double :marray dim0)))
:initialize-suffix "set" :initialize-suffix "set"
:initialize-args :initialize-args
((callback :pointer) ((mpointer initial) :pointer) ((callback :pointer) ((mpointer initial) :pointer)
...@@ -439,9 +439,51 @@ ...@@ -439,9 +439,51 @@
(let ((x (solution minimizer))) (let ((x (solution minimizer)))
(values (maref x 0) (maref x 1) (function-value minimizer))))))) (values (maref x 0) (maref x 1) (function-value minimizer)))))))
(defun paraboloid-derivative-scalar (x y)
(let ((dp0 (aref *paraboloid-center* 0))
(dp1 (aref *paraboloid-center* 1)))
(values
(* 20 (- x dp0))
(* 40 (- y dp1)))))
(defun paraboloid-and-derivative-scalar (x y)
(values-list
(cons (paraboloid-scalar x y)
(multiple-value-list (paraboloid-derivative-scalar x y)))))
(defun multimin-example-derivative-scalars
(&optional (method +conjugate-fletcher-reeves+) (print-steps t))
(let* ((initial #m(5.0d0 7.0d0))
(minimizer
(make-multi-dimensional-minimizer-fdf
method 2
'(paraboloid-scalar paraboloid-derivative-scalar paraboloid-and-derivative-scalar)
initial 0.01d0 1.0d-4 t)))
(loop with status = T
for iter from 0 below 100
while status
do
(iterate minimizer)
(setf status
(not (min-test-gradient
(mfdfminimizer-gradient minimizer)
1.0d-3)))
(when print-steps
(let ((x (solution minimizer)))
(format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~&"
iter (maref x 0) (maref x 1)
(function-value minimizer))))
finally
(return
(let ((x (solution minimizer)))
(values (maref x 0) (maref x 1) (function-value minimizer)))))))
(save-test minimization-multi (save-test minimization-multi
(multimin-example-no-derivative +simplex-nelder-mead-on2+ nil) (multimin-example-no-derivative +simplex-nelder-mead-on2+ nil)
(multimin-example-derivative +conjugate-fletcher-reeves+ nil) (multimin-example-derivative +conjugate-fletcher-reeves+ nil)
(multimin-example-derivative +conjugate-polak-ribiere+ nil) (multimin-example-derivative +conjugate-polak-ribiere+ nil)
(multimin-example-derivative +vector-bfgs+ nil) (multimin-example-derivative +vector-bfgs+ nil)
(multimin-example-derivative +vector-bfgs2+ nil)) (multimin-example-derivative +vector-bfgs2+ nil)
(multimin-example-derivative-scalars +vector-bfgs2+ nil))
;;; Multivariate roots. ;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08 ;;; Liam Healy 2008-01-12 12:49:08
;;; Time-stamp: <2009-06-06 16:53:34EDT roots-multi.lisp> ;;; Time-stamp: <2009-06-09 22:30:12EDT roots-multi.lisp>
;;; $Id$ ;;; $Id$
(in-package :gsl) (in-package :gsl)
...@@ -25,7 +25,7 @@ ...@@ -25,7 +25,7 @@
the specified number of dimensions. Optionally the specified number of dimensions. Optionally
set or reset an existing solver to use the function and the set or reset an existing solver to use the function and the
initial guess gsl-vector. If scalarsp is T, the functions will initial guess gsl-vector. If scalarsp is T, the functions will
be supplied, and should return scalars." be supplied scalars, and should return scalars."
:initialize-suffix "set" :initialize-suffix "set"
:initialize-args ((callback :pointer) ((mpointer initial) :pointer)) :initialize-args ((callback :pointer) ((mpointer initial) :pointer))
:callbacks :callbacks
......
...@@ -3,28 +3,33 @@ ...@@ -3,28 +3,33 @@
(in-package :gsl) (in-package :gsl)
(LISP-UNIT:DEFINE-TEST MINIMIZATION-MULTI (LISP-UNIT:DEFINE-TEST MINIMIZATION-MULTI
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST 0.9920430849306285d0 1.9969168063253164d0 (LIST 0.9920430849306285d0 1.9969168063253164d0
30.000823246638923d0) 30.000823246638923d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-NO-DERIVATIVE +SIMPLEX-NELDER-MEAD-on2+ (MULTIMIN-EXAMPLE-NO-DERIVATIVE
NIL))) +SIMPLEX-NELDER-MEAD-ON2+ NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999997d0 2.0d0 30.0d0) (LIST 0.9999999999999997d0 2.0d0 30.0d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE (MULTIMIN-EXAMPLE-DERIVATIVE
+CONJUGATE-FLETCHER-REEVES+ NIL))) +CONJUGATE-FLETCHER-REEVES+ NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999997d0 2.0d0 30.0d0) (LIST 0.9999999999999997d0 2.0d0 30.0d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE +CONJUGATE-POLAK-RIBIERE+ (MULTIMIN-EXAMPLE-DERIVATIVE +CONJUGATE-POLAK-RIBIERE+
NIL))) NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999997d0 2.0d0 30.0d0) (LIST 0.9999999999999997d0 2.0d0 30.0d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS+ NIL))) (MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS+ NIL)))
(let ((lisp-unit:*epsilon* (* 2400 double-float-epsilon))) (LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL (LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0)
(LIST 1.0d0 2.0d0 30.0d0) (MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS2+ NIL)))
(LISP-UNIT:ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999998208d0 1.9999999999995521d0 30.0d0)
(MULTIPLE-VALUE-LIST (MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE +VECTOR-BFGS2+ NIL))))) (MULTIMIN-EXAMPLE-DERIVATIVE-SCALARS +VECTOR-BFGS2+
NIL))))
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