Commit 78b88074 authored by Liam Healy's avatar Liam Healy

Minimization will take scalar functions, added tests, optional printing

The minimization functions may now take and return scalars or marrays.
The examples take optional arguments with the solver method and
whether to print the steps.  They are now part of the #'examples and
test suite.  Use maref instead of cl-array in
#'roots-multi-example-no-derivative.  Add optional solver method to
roots one and roots multi, and add tests for all solvers.
parent 1060d1dc
......@@ -34,6 +34,7 @@ Fail in CCL but not in SBCL:
series-acceleration
linear-least-squares
nonlinear-least-squares
minimization-multi
=== GSL questions ===
Sun Nov 9 2008:
......
;; Definition of GSLL system
;; Liam Healy
;; Time-stamp: <2009-01-21 22:58:22EST gsll-tests.asd>
;; Time-stamp: <2009-01-22 21:37:49EST gsll-tests.asd>
;; $Id$
(asdf:defsystem "gsll-tests"
......@@ -116,6 +116,8 @@
(:file "matrix-variance-with-fixed-mean")
(:file "matrix-variance-with-mean")
(:file "median-percentile")
(:file "minimization-one")
(:file "minimization-multi")
(:file "monte-carlo")
(:file "multinomial")
(:file "negative-binomial")
......
;; Foreign callback functions.
;; Liam Healy
;; Time-stamp: <2009-01-19 16:44:13EST callback.lisp>
;; Time-stamp: <2009-01-22 22:36:00EST callback.lisp>
;; $Id$
(in-package :gsl)
......@@ -20,13 +20,17 @@
;;; Other GSL tasks make use of callback functions with different
;;; characteristics. Since they are specific to each of the tasks,
;;; they are defined with those tasks. A complexity encountered with
;;; using a vector of double floats not present with scalars is that
;;; there is no portable way to make a C array available directly to
;;; Lisp, so callbacks using C arrays must read them using a macro.
;;; Therefore it is necessary to define the function in a way that
;;; prevents its use in Lisp; to ameliorate this, the macro
;;; #'with-c-double is provided to give named access to the elements.
;;; they are defined with those tasks. The macro #'defmcallback can
;;; specify that the CL function is to expect in arglist and return as
;;; multiple values scalar quantities that come from and will be bound
;;; to either marrays or C vectors. This is done with a list of the
;;; type and size, e.g. (:double 3), and for setting :set, type size,
;;; e.g. (:set :double 3). If the 'marray argument is nil, it will
;;; expand to read or set a C vector; if it is T, it will expand to
;;; read or set a marray. This allows the user to define ordinary CL
;;; functions with scalars as input and output. However, it may be
;;; desirable to read and set marrays, in which case :pointer is the
;;; right specification.
(export
'(def-single-function undef-cbstruct defun-single
......@@ -90,6 +94,7 @@
;;; (callback-args '(:double (:double 2) (:set :double 2)))
;;; ((#:ARG1193 :DOUBLE) (#:ARG1194 :POINTER) (#:ARG1195 :POINTER))
(defun callback-args (types)
"The arguments passed by GSL to the callback function."
(mapcar (lambda (type)
......@@ -102,12 +107,18 @@
;;; (embedded-clfunc-args '(:double (:double 2) (:set :double 2)) (callback-args '(:double (:double 2) (:set :double 2))))
;;; (#:ARG1244 (MEM-AREF #:ARG1245 ':DOUBLE 0) (MEM-AREF #:ARG1245 ':DOUBLE 1))
(defvar *setting-spec* '(:set))
(defun embedded-clfunc-args (types callback-args &optional marray)
"The arguments passed to the CL function call embedded in the callback."
"The arguments passed to the CL function call embedded in the callback.
If 'marray is T, then reference GSL arrays; otherwise reference raw
C vectors. A specification (:set ...) means that the CL function
will define the array as multiple values; if the size is negative,
then the opposite value will be used for marray."
(loop for spec in types
for (symbol nil) in callback-args
append
(unless (and (listp spec) (eq (first spec) :set))
(unless (and (listp spec) (member (first spec) *setting-spec*))
(if (listp spec)
(if (third spec)
;; matrix, marrays only
......@@ -115,10 +126,10 @@
append
(loop for j from 0 below (third spec)
collect
`(maref ,symbol ,i ,j ',(cffi-cl (first spec)))))
`(maref ,symbol ,i ,j ',(cffi-cl (first spec)))))
;; vector, marray or C array
(loop for ind from 0 below (second spec)
collect (if marray
(loop for ind from 0 below (abs (second spec))
collect (if (if (minusp (second spec)) (not marray) marray)
`(maref ,symbol ,ind nil ',(cffi-cl (first spec)))
`(cffi:mem-aref ,symbol ',(first spec) ,ind))))
(list symbol)))))
......@@ -128,14 +139,17 @@
(multiple-value-bind (settype setcba)
(loop for cba in callback-args
for type in types
for setting = (and (listp type) (eq (first type) :set))
for setting = (and (listp type) (member (first type) *setting-spec*))
when setting
collect cba into setcba
when setting
collect type into settype
finally (return (values (mapcar 'rest settype) setcba)))
(let* ((setvbls (embedded-clfunc-args settype setcba marray))
(count (apply '+ (mapcar (lambda (inds) (apply '* (rest inds))) settype)))
(count
(apply
'+
(mapcar (lambda (inds) (abs (apply '* (rest inds)))) settype)))
(mvbvbls (loop repeat count collect (gensym "SETCB"))))
(if (zerop count)
form
......@@ -145,9 +159,6 @@
for setvbl in setvbls
append (list setvbl mvbvbl))))))))
;;; (DEFMCALLBACK VANDERPOL :SUCCESS-FAILURE (:DOUBLE (:DOUBLE 2) (:SET :DOUBLE 2)))
;;; (DEFMCALLBACK VANDERPOL :SUCCESS-FAILURE (:DOUBLE (:DOUBLE 2)))
(defmacro defmcallback
(name &optional (return-type :double) (argument-types :double)
additional-argument-types marray)
......
;; Multivariate minimization.
;; Liam Healy <Tue Jan 8 2008 - 21:28>
;; Time-stamp: <2009-01-03 13:27:12EST minimization-multi.lisp>
;; Time-stamp: <2009-01-22 21:35:26EST minimization-multi.lisp>
;; $Id$
(in-package :gsl)
;;; /usr/include/gsl/gsl_multimin.h
;; In the parabaloid example, I notice that the consruct
;; (min-test-gradient (mfdfminimizer-gradient minimizer) 1.0d-3)
;; is constructing a CL vector-double-float (in mfdfminimizer-gradient) and
;; then immediately pulling out the pointer (in min-test-gradient). It
;; is easy enough to eliminate this, but then mfdfminimizer-gradient
;; would not be useful to a CL user.
;;; In the parabaloid example, I notice that the consruct
;;; (min-test-gradient (mfdfminimizer-gradient minimizer) 1.0d-3)
;;; is constructing a CL vector-double-float (in mfdfminimizer-gradient) and
;;; then immediately pulling out the pointer (in min-test-gradient). It
;;; is easy enough to eliminate this, but then mfdfminimizer-gradient
;;; would not be useful to a CL user.
;;;;****************************************************************************
;;;; Function definition
......@@ -28,23 +28,24 @@
;;; they point to have different signatures.
(export 'def-minimization-functions)
(defmacro def-minimization-functions (function dimensions &optional df fdf)
(defmacro def-minimization-functions (function dimensions &optional df fdf array)
"Setup functions for multivariate minimization.
The CL functions name and derivative should be defined previously
with defuns."
`(progn
(defmcallback ,function :double :pointer)
,@(when df
`((defmcallback ,df :pointer :pointer :pointer)
(defmcallback ,fdf :pointer :pointer (:pointer :pointer))))
,(if df
`(defcbstruct (,function function ,df df ,fdf fdf)
gsl-mfunction-fdf
((dimensions ,dimensions)))
`(defcbstruct (,function function)
gsl-mfunction
((dimensions ,dimensions))))))
(let ((vdec (if array :pointer `((:double ,dimensions))))
(svdec (if array :pointer `(:set :double ,dimensions))))
`(progn
(defmcallback ,function :double ,vdec nil t)
,@(when df
`((defmcallback ,df :void ,vdec (,svdec) t)
(defmcallback ,fdf :void ,vdec ((:set :double -1) ,svdec) t)))
,(if df
`(defcbstruct (,function function ,df df ,fdf fdf)
gsl-mfunction-fdf
((dimensions ,dimensions)))
`(defcbstruct (,function function)
gsl-mfunction
((dimensions ,dimensions)))))))
;;;;****************************************************************************
;;;; Initialization
......@@ -280,10 +281,13 @@
;;; Examples from Sec. 35.8.
;;; Example using derivatives, taking a vector argument.
(defparameter *parabaloid-center* #(1.0d0 2.0d0))
(defun parabaloid (gsl-vector-pointer)
"A parabaloid function of two arguments, given in GSL manual Sec. 35.4."
"A parabaloid function of two arguments, given in GSL manual Sec. 35.4.
This version takes a vector-double-float argument."
(let ((x (maref gsl-vector-pointer 0))
(y (maref gsl-vector-pointer 1))
(dp0 (aref *parabaloid-center* 0))
......@@ -303,20 +307,21 @@
(maref derivative-gv-pointer 1)
(* 40 (- y dp1)))))
(defun parabaloid-and-derivative
(arguments-gv-pointer fnval derivative-gv-pointer)
(setf (dcref fnval) (parabaloid arguments-gv-pointer))
(parabaloid-derivative
arguments-gv-pointer derivative-gv-pointer))
(defun parabaloid-and-derivative (arguments-gv-pointer derivative-gv-pointer)
(prog1
(parabaloid arguments-gv-pointer)
(parabaloid-derivative
arguments-gv-pointer derivative-gv-pointer)))
(def-minimization-functions
parabaloid 2 parabaloid-derivative parabaloid-and-derivative)
parabaloid 2 parabaloid-derivative parabaloid-and-derivative t)
(defun multimin-example-fletcher-reeves ()
(defun multimin-example-derivative
(&optional (method *conjugate-fletcher-reeves*) (print-steps t))
(let* ((initial #m(5.0d0 7.0d0))
(minimizer
(make-multi-dimensional-minimizer-fdf
*conjugate-fletcher-reeves* 2 parabaloid
method 2 parabaloid
initial 0.01d0 1.0d-4)))
(loop with status = T
for iter from 0 below 100
......@@ -327,29 +332,36 @@
(not (min-test-gradient
(mfdfminimizer-gradient minimizer)
1.0d-3)))
(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)))))))
;;; Because def-minimization-functions bind a symbol
;;; of the same name as the first function, and we want both to run,
;;; we'll make an alias function so we can use both.
(defun parabaloid-f (gsl-vector-pointer)
(parabaloid gsl-vector-pointer))
(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)))))))
;;; Example without derivatives, same function but now defined using
(defun parabaloid-f (x y)
"A parabaloid function of two arguments, given in GSL manual Sec. 35.4.
This version takes scalar arguments."
(let ((dp0 (aref *parabaloid-center* 0))
(dp1 (aref *parabaloid-center* 1)))
(+ (* 10 (expt (- x dp0) 2))
(* 20 (expt (- y dp1) 2))
30)))
(def-minimization-functions parabaloid-f 2)
(defun multimin-example-nelder-mead ()
(let ((initial #m(5.0d0 7.0d0))
(step-size (make-marray 'double-float :dimensions 2)))
(defun multimin-example-no-derivative
(&optional (method *simplex-nelder-mead*) (print-steps t))
(let ((step-size (make-marray 'double-float :dimensions 2)))
(set-all step-size 1.0d0)
(let ((minimizer
(make-multi-dimensional-minimizer-f
*simplex-nelder-mead* 2 parabaloid-f initial step-size)))
method 2 parabaloid-f #m(5.0d0 7.0d0) step-size)))
(loop with status = T and size
for iter from 0 below 100
while status
......@@ -358,11 +370,19 @@
(mfminimizer-size minimizer)
status
(not (min-test-size size 1.0d-2)))
(let ((x (solution minimizer)))
(format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f"
iter (maref x 0) (maref x 1)
(function-value minimizer)
size))
finally (return
(let ((x (solution minimizer)))
(values (maref x 0) (maref x 1))))))))
(when print-steps
(let ((x (solution minimizer)))
(format t "~d~6t~10,6f~18t~10,6f~28t~12,9f~40t~8,3f~&"
iter (maref x 0) (maref x 1)
(function-value minimizer)
size)))
finally
(return
(let ((x (solution minimizer)))
(values (maref x 0) (maref x 1) (function-value minimizer))))))))
(save-test minimization-multi
(multimin-example-no-derivative *simplex-nelder-mead* nil)
(multimin-example-derivative *conjugate-fletcher-reeves* nil)
(multimin-example-derivative *conjugate-polak-ribiere* nil)
(multimin-example-derivative *vector-bfgs* nil))
;; Univariate minimization
;; Liam Healy Tue Jan 8 2008 - 21:02
;; Time-stamp: <2009-01-03 15:42:59EST minimization-one.lisp>
;; Time-stamp: <2009-01-22 18:59:23EST minimization-one.lisp>
;; $Id$
(in-package :gsl)
......@@ -178,24 +178,34 @@
(defun-single minimization-one-fn (x)
(1+ (cos x)))
(defun minimization-one-example ()
(defun minimization-one-example
(&optional (minimizer-type *brent-fminimizer*) (print-steps t))
"Solving a minimum, the example given in Sec. 33.8 of the GSL manual."
(let ((max-iter 100)
(minimizer
(make-one-dimensional-minimizer
*brent-fminimizer* minimization-one-fn 2.0d0 0.0d0 6.0d0)))
(format t "~&iter ~6t [lower ~24tupper] ~36tmin ~44tmin err ~54tupper-lower")
minimizer-type minimization-one-fn 2.0d0 0.0d0 6.0d0)))
(when print-steps
(format
t
"iter ~6t [lower ~24tupper] ~36tmin ~44tmin err ~54tupper-lower~&"))
(loop for iter from 0
for min = (solution minimizer)
for lower = (fminimizer-x-lower minimizer)
for upper = (fminimizer-x-upper minimizer)
do (iterate minimizer)
(when print-steps
(format t "~d~6t~10,6f~18t~10,6f~28t~12,9f ~44t~10,4g ~10,4g~&"
iter lower upper
min (- min pi)
(- upper lower)))
while (and (< iter max-iter)
;; abs and rel error swapped in example?
(not (min-test-interval lower upper 0.001d0 0.0d0)))
do
(format t "~&~d~6t~10,6f~18t~10,6f~28t~12,9f ~44t~10,4g ~10,4g"
iter lower upper
min (- min pi)
(- upper lower)))))
finally
(return (values iter lower upper min (- min pi) (- upper lower))))))
(save-test minimization-one
(minimization-one-example *brent-fminimizer* nil)
(minimization-one-example *golden-section-fminimizer* nil))
;;; Multivariate roots.
;;; Liam Healy 2008-01-12 12:49:08
;;; Time-stamp: <2009-01-21 22:38:26EST roots-multi.lisp>
;;; Time-stamp: <2009-01-22 22:19:34EST roots-multi.lisp>
;;; $Id$
(in-package :gsl)
......@@ -385,32 +385,33 @@
(def-mfunction rosenbrock 2)
(defun roots-multi-example (&optional (print-steps t))
(defun roots-multi-example-no-derivative
(&optional (method *hybrid-scaled*) (print-steps t))
"Solving Rosenbrock, the example given in Sec. 34.8 of the GSL manual."
(let ((max-iter 1000))
(let* ((vect #m(-10.0d0 -5.0d0))
(solver (make-multi-dimensional-root-solver-f
*hybrid-scaled* rosenbrock vect)))
(loop for iter from 0
with fnval and argval
while (and (< iter max-iter)
(not (multiroot-test-residual solver 1.0d-7)))
do
(iterate solver)
(setf fnval (cl-array (function-value solver))
argval (cl-array (solution solver)))
(when print-steps
(format t "iter=~d~8tx0=~12,8g~24tx1=~12,8g~38tf0=~12,8g~52tf1=~12,8g~&"
iter
(aref argval 0)
(aref argval 1)
(aref fnval 0)
(aref fnval 1)))
finally (return
(values (aref argval 0)
(aref argval 1)
(aref fnval 0)
(aref fnval 1)))))))
(let ((max-iter 1000)
(solver (make-multi-dimensional-root-solver-f
method rosenbrock
#m(-10.0d0 -5.0d0))))
(loop for iter from 0
with fnval and argval
while (and (< iter max-iter)
(not (multiroot-test-residual solver 1.0d-7)))
do
(iterate solver)
(setf fnval (function-value solver)
argval (solution solver))
(when print-steps
(format t "iter=~d~8tx0=~12,8g~24tx1=~12,8g~38tf0=~12,8g~52tf1=~12,8g~&"
iter
(maref argval 0)
(maref argval 1)
(maref fnval 0)
(maref fnval 1)))
finally (return
(values (maref argval 0)
(maref argval 1)
(maref fnval 0)
(maref fnval 1))))))
(defun rosenbrock-df (arg0 arg1)
"The partial derivatives of the Rosenbrock functions."
......@@ -436,7 +437,7 @@
(def-solver-functions rosenbrock-f rosenbrock-df rosenbrock-fdf 2)
(defun roots-multi-example-df (&optional (print-steps t))
(defun roots-multi-example-derivative (&optional (method *gnewton-mfdfsolver*) (print-steps t))
"Solving Rosenbrock with derivatives, the example given in Sec. 34.8
of the GSL manual."
(flet ((print-state (iter argval fnval)
......@@ -447,27 +448,35 @@
(maref argval 1)
(maref fnval 0)
(maref fnval 1)))))
(let ((max-iter 1000))
(let* ((vect #m(-10.0d0 -5.0d0))
(solver (make-multi-dimensional-root-solver-fdf
*gnewton-mfdfsolver* rosenbrock-f vect)))
(loop for iter from 0
with fnval = (function-value solver)
and argval = (solution solver)
while (and (< iter max-iter)
(not (multiroot-test-residual solver 1.0d-7)))
initially (print-state iter argval fnval)
do
(iterate solver)
(setf fnval (function-value solver)
argval (solution solver))
(print-state iter argval fnval)
finally (return
(values (maref argval 0)
(maref argval 1)
(maref fnval 0)
(maref fnval 1))))))))
(let ((max-iter 1000)
(solver (make-multi-dimensional-root-solver-fdf
method rosenbrock-f
#m(-10.0d0 -5.0d0))))
(loop for iter from 0
with fnval = (function-value solver)
and argval = (solution solver)
while (and (< iter max-iter)
(not (multiroot-test-residual solver 1.0d-7)))
initially (print-state iter argval fnval)
do
(iterate solver)
(setf fnval (function-value solver)
argval (solution solver))
(print-state iter argval fnval)
finally (return
(values (maref argval 0)
(maref argval 1)
(maref fnval 0)
(maref fnval 1)))))))
;; To see step-by-step information as the solution progresses, make
;; the last argument T.
(save-test roots-multi
(roots-multi-example nil)
(roots-multi-example-df nil))
(roots-multi-example-no-derivative *hybrid-unscaled* nil)
(roots-multi-example-no-derivative *hybrid-scaled* nil)
(roots-multi-example-no-derivative *discrete-newton* nil)
(roots-multi-example-no-derivative *broyden* nil)
(roots-multi-example-derivative *newton-mfdfsolver* nil)
(roots-multi-example-derivative *gnewton-mfdfsolver* nil)
(roots-multi-example-derivative *powells-hybrid* nil)
(roots-multi-example-derivative *powells-hybrid-unscaled* nil))
;; One-dimensional root solver.
;; Liam Healy
;; Time-stamp: <2009-01-19 22:04:19EST roots-one.lisp>
;; Time-stamp: <2009-01-22 22:15:50EST roots-one.lisp>
;; $Id$
(in-package :gsl)
......@@ -330,12 +330,12 @@
(def-single-function quadratic)
(defun roots-one-example (&optional (print-steps t))
(defun roots-one-example-no-derivative
(&optional (method *brent-fsolver*) (print-steps t))
"Solving a quadratic, the example given in Sec. 32.10 of the GSL manual."
(let ((max-iter 50)
(solver
(make-one-dimensional-root-solver-f
*brent-fsolver* quadratic 0.0d0 5.0d0)))
(make-one-dimensional-root-solver-f method quadratic 0.0d0 5.0d0)))
(when print-steps
(format t "iter ~6t [lower ~24tupper] ~36troot ~44terr ~54terr(est)~&"))
(loop for iter from 0
......@@ -361,12 +361,13 @@
(def-solver-functions
quadratic-df quadratic-derivative quadratic-and-derivative)
(defun roots-one-fdf-example (&optional (print-steps t))
(defun roots-one-example-derivative
(&optional (method *newton-fdfsolver*) (print-steps t))
"Solving a quadratic, the example given in Sec. 32.10 of the GSL manual."
(let* ((max-iter 100)
(initial 5.0d0)
(solver (make-one-dimensional-root-solver-fdf
*newton-fdfsolver* quadratic-df initial)))
method quadratic-df initial)))
(when print-steps
(format t "iter ~6t ~8troot ~22terr ~34terr(est)~&"))
(loop for iter from 0
......@@ -380,6 +381,12 @@
iter root (- root (sqrt 5.0d0)) (- root oldroot)))
finally (return root))))
;; To see step-by-step information as the solution progresses, make
;; the last argument T.
(save-test roots-one
(roots-one-example nil)
(roots-one-fdf-example nil))
(roots-one-example-no-derivative *bisection-fsolver* nil)
(roots-one-example-no-derivative *false-position-fsolver* nil)
(roots-one-example-no-derivative *brent-fsolver* nil)
(roots-one-example-derivative *newton-fdfsolver* nil)
(roots-one-example-derivative *secant-fdfsolver* nil)
(roots-one-example-derivative *steffenson-fdfsolver* nil))
;; Regression test MINIMIZATION-MULTI for GSLL, automatically generated
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST MINIMIZATION-MULTI
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.9920430849306285d0 1.9969168063253164d0
30.000823246638923d0)
(MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-NO-DERIVATIVE *SIMPLEX-NELDER-MEAD*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999997d0 2.0d0 30.0d0)
(MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE
*CONJUGATE-FLETCHER-REEVES* NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999997d0 2.0d0 30.0d0)
(MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE *CONJUGATE-POLAK-RIBIERE*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999997d0 2.0d0 30.0d0)
(MULTIPLE-VALUE-LIST
(MULTIMIN-EXAMPLE-DERIVATIVE *VECTOR-BFGS* NIL))))
;; Regression test MINIMIZATION-ONE for GSLL, automatically generated
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST MINIMIZATION-ONE
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 6 3.141474321994987d0 3.1415930343642042d0
3.141592654724622d0 1.134828675475319d-9
1.1871236921701112d-4)
(MULTIPLE-VALUE-LIST
(MINIMIZATION-ONE-EXAMPLE *BRENT-FMINIMIZER* NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 24 3.1413247152275243d0 3.1419619412229034d0
3.1415652995716155d0 -2.7354018177661032d-5
6.37225995379076d-4)
(MULTIPLE-VALUE-LIST
(MINIMIZATION-ONE-EXAMPLE *GOLDEN-SECTION-FMINIMIZER*
NIL))))
......@@ -3,11 +3,48 @@
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST ROOTS-MULTI
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999992d0 0.9999999999999716d0
7.771561172376096d-16 -2.686739719592879d-13)
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-NO-DERIVATIVE *HYBRID-UNSCALED*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0 1.0d0 0.0d0 0.0d0)
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-NO-DERIVATIVE *HYBRID-SCALED*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0 1.0000000000000004d0 0.0d0
4.440892098500626d-15)
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-NO-DERIVATIVE *DISCRETE-NEWTON*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0 1.0000000000000568d0 0.0d0
5.684341886080801d-13)
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-NO-DERIVATIVE *BROYDEN* NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0 1.0d0 0.0d0 0.0d0)
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-DERIVATIVE *NEWTON-MFDFSOLVER*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.999999999999998d0 0.9999999999999964d0
1.9984014443252818d-15 4.440892098500626d-15)
(MULTIPLE-VALUE-LIST (ROOTS-MULTI-EXAMPLE-DF NIL)))
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-DERIVATIVE *GNEWTON-MFDFSOLVER*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 1.0d0 1.0d0 0.0d0 0.0d0)
(MULTIPLE-VALUE-LIST (ROOTS-MULTI-EXAMPLE NIL))))
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-DERIVATIVE *POWELLS-HYBRID*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 0.9999999999999996d0 1.0000000000000568d0
4.440892098500626d-16 5.773159728050814d-13)
(MULTIPLE-VALUE-LIST
(ROOTS-MULTI-EXAMPLE-DERIVATIVE
*POWELLS-HYBRID-UNSCALED* NIL))))
......@@ -3,10 +3,34 @@
(in-package :gsl)
(LISP-UNIT:DEFINE-TEST ROOTS-ONE
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2.2357177734375d0)
(MULTIPLE-VALUE-LIST
(ROOTS-ONE-EXAMPLE-NO-DERIVATIVE *BISECTION-FSOLVER*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2.23606797749979d0)
(MULTIPLE-VALUE-LIST
(ROOTS-ONE-EXAMPLE-NO-DERIVATIVE
*FALSE-POSITION-FSOLVER* NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2.2360634081902244d0)
(MULTIPLE-VALUE-LIST (ROOTS-ONE-EXAMPLE NIL)))
(MULTIPLE-VALUE-LIST
(ROOTS-ONE-EXAMPLE-NO-DERIVATIVE *BRENT-FSOLVER*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2.236067977499978d0)
(MULTIPLE-VALUE-LIST (ROOTS-ONE-FDF-EXAMPLE NIL))))
(MULTIPLE-VALUE-LIST
(ROOTS-ONE-EXAMPLE-DERIVATIVE *NEWTON-FDFSOLVER*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2.2360679849648637d0)
(MULTIPLE-VALUE-LIST
(ROOTS-ONE-EXAMPLE-DERIVATIVE *SECANT-FDFSOLVER*
NIL)))
(LISP-UNIT::ASSERT-NUMERICAL-EQUAL
(LIST 2.23606797749979d0)
(MULTIPLE-VALUE-LIST
(ROOTS-ONE-EXAMPLE-DERIVATIVE *STEFFENSON-FDFSOLVER*
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