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
‘———————————————————————-
‘
‘ Brent’s 1-dim minimizer
‘ ported from netlib C math library with minor modifications
‘ uses a function f to be defined
‘ AVt, Apr 2005
‘ fminbr.c Brent’s 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 Double
Const EPSILON As Double = 1E-300 ' 2 ^ (-52)
Const SQRT_EPSILON As Double = 1E-150
Dim x As Double, v As Double, w As Double
Dim fx As Double
Dim fv As Double
Dim fw As Double
Dim r As Double
Dim counter As Integer
Dim range As Double, middle_range As Double, tol_act As Double, new_range As Double, new_step As Double, tmp As Double
Dim p As Double, q As Double, t As Double, ft As Double
r = (3# - Sqr(5#)) / 2
'assert( tol > 0 && b > a );
If (0 < tol And a < b) Then
Else
Exit Function
End If
v = a + r * (b - a)
fv = f(v)
x = v
w = v
fx = fv
fw = fv
For counter = 1 To 200
range = b - a
middle_range = (a + b) / 2
tol_act = SQRT_EPSILON * Abs(x) + tol / 3
tol_act = 0.000000000000001
If (Abs(x - middle_range) + range / 2 <= 2 * tol_act) Then
Exit For
End If
If (x < middle_range) Then
tmp = b - x
Else
tmp = a - x
End If
new_step = r * tmp
If (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)) Then
new_step = p / q
End If
End If
If (Abs(new_step) < tol_act) Then
If (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) Then
If (t < x) Then
b = x
Else
a = x
End If
v = w
w = x
x = t
fv = fw
fw = fx
fx = ft
Else
If (t < x) Then
a = t
Else
b = t
End If
If (ft <= fw Or w = x) Then
v = w
w = t
fv = fw
fw = ft
ElseIf (ft <= fv Or v = x Or v = w) Then
v = t
fv = ft
End If
End If
Next counter
fminbr = x
End Function