[SOLVED] algorithm Option Explicit

Option Explicit

Sub test()
Dim someMin As Double
Dim lower As Double, upper As Double

lower = -1
upper = 3

someMin = fminbr(lower, upper, 0.0000000001)

Cells(1, 1) = someMin
Cells(1, 2) = f(someMin)
End Sub

Function f(x As Double) As Double
f = (Cos(x) x) ^ 2 2
End Function

–

Brents 1-dim minimizer
ported from netlib C math library with minor modifications
uses a function f to be defined

AVt, Apr 2005

fminbr.cBrents univariate minimizer: source from netlib C math library

************************************************************************
* C math library
* function FMINBR one-dimensional search for a function minimum
* over the given range
*
* Input
* double fminbr(a,b,f,tol)
* double a; Minimum will be seeked for over
* double b; a range [a,b], a being < b.’ * double (*f)(double x);Name of the function whose minimum’ * will be seeked for’ * double tol; Acceptable tolerance for the minimum’ * location. It have to be positive’ * (e.g. may be specified as EPSILON)’ *’ * Output’ * Fminbr returns an estimate for the minimum location with accuracy’ * 3*SQRT_EPSILON*abs(x) + tol.’ * The function always obtains a local minimum which coincides with’ * the global one only if a function under investigation being’ * unimodular.’ * If a function being examined possesses no local minimum within’ * the given range, Fminbr returns ‘a’ (if f(a) < f(b)), otherwise’ * it returns the right range boundary value b.’ *’ * Algorithm’ * G.Forsythe, M.Malcolm, C.Moler, Computer methods for mathematical’ * computations. M., Mir, 1980, p.202 of the Russian edition’ *’ * The function makes use of the “gold section” procedure combined with’ * the parabolic interpolation.’ * At every step program operates three abscissae – x,v, and w.’ * x – the last and the best approximation to the minimum location,’ * i.e. f(x) <= f(a) or/and f(x) <= f(b)’ * (if the function f has a local minimum in (a,b), then the both’ * conditions are fulfiled after one or two steps).’ * v,w are previous approximations to the minimum location. They may’ * coincide with a, b, or x (although the algorithm tries to make all’ * u, v, and w distinct). Points x, v, and w are used to construct’ * interpolating parabola whose minimum will be treated as a new’ * approximation to the minimum location if the former falls within’ * [a,b] and reduces the range enveloping minimum more efficient than’ * the gold section procedure.’ * When f(x) has a second derivative positive at the minimum location’ * (not coinciding with a or b) the procedure converges superlinearly’ * at a rate order about 1.324′ *’ ************************************************************************Function fminbr(a As Double, b As Double, tol As Double) As DoubleConst EPSILON As Double = 1E-300 ‘ 2 ^ (-52)Const SQRT_EPSILON As Double = 1E-150Dim x As Double, v As Double, w As DoubleDim fx As DoubleDim fv As DoubleDim fw As DoubleDim rAs DoubleDim counter As IntegerDim range As Double, middle_range As Double, tol_act As Double, new_range As Double, new_step As Double, tmp As DoubleDim p As Double, q As Double, t As Double, ft As Doubler = (3# – Sqr(5#)) / 2’assert( tol > 0 && b > a );
If (0 < tol And a < b) ThenElseExit FunctionEnd Ifv = a + r * (b – a)fv = f(v)x = vw = vfx = fvfw = fvFor counter = 1 To 200range = b – amiddle_range = (a + b) / 2tol_act = SQRT_EPSILON * Abs(x) + tol / 3tol_act = 0.000000000000001If (Abs(x – middle_range) + range / 2 <= 2 * tol_act) ThenExit ForEnd IfIf (x < middle_range) Thentmp = b – xElsetmp = a – xEnd Ifnew_step = r * tmpIf (Abs(x – w) >= tol_act) Then
t = (x w) * (fx fv)
q = (x v) * (fx fw)
p = (x v) * q (x w) * t
q = 2 * (q t)

If (q > 0) Then
p = -p
Else
q = -q
End If

If (Abs(p) < Abs(new_step * q) And _p > q * (a x + 2 * tol_act) And _
p < q * (b – x – 2 * tol_act)) Thennew_step = p / qEnd IfEnd IfIf (Abs(new_step) < tol_act) ThenIf (new_step > 0) Then
new_step = tol_act
Else
new_step = -tol_act
End If
End If

t = x + new_step
ft = f(t)
If (ft <= fx) ThenIf (t < x) Thenb = xElsea = xEnd Ifv = ww = xx = tfv = fwfw = fxfx = ftElseIf (t < x) Thena = tElseb = tEnd IfIf (ft <= fw Or w = x) Thenv = ww = tfv = fwfw = ftElseIf (ft <= fv Or v = x Or v = w) Thenv = tfv = ftEnd IfEnd IfNext counterfminbr = xEnd Function