Option Explicit
Private Const EPSILON As Double = 1E-300 ‘ 2 ^ (-52)
Private Const SQRT_EPSILON As Double = 1E-150
Copyright By PowCoder代写 加微信 powcoder
‘————————————————————————–
Function f(x As Double, y As Double) As Double
‘define function f
f = x ^ 3 – 2 * y – 5
End Function
Function fa2(x)
‘define function fa2
End Function
Function fb2(x)
‘define function fb2
End Function
‘————————————————————————–
‘Brent’s 2-dim minimizer of var1 and var2 in f(var1,var2)
‘ f(var1,var2) – user-defined function
‘ a1 – lower limit of var1
‘ b1 – upper limit of var1
‘ fa2(var1) – boundary function for the lower limit of var2 given var1
‘ fb2(var1) – boundary fuction for the upper limit of var2 given var1
‘ tol- tolerance of the solution
‘ optVar1, optVar2 – optimal values of var1 and var2
Sub f2minbr(a1 As Double, b1 As Double, tol As Double, optVar1 As Double, optVar2 As Double)
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
Dim a2 As Double, b2 As Double, v2 As Double
Dim maxIteration As Integer: maxIteration = 100
r = (3# – Sqr(5#)) / 2
‘assert( tol > 0 && b > a );
If (tol < 0 Or a1 >= b1) Then
v = a1 + r * (b1 – a1)
a2 = fa2(v)
b2 = fb2(v)
v2 = f1minbr_var2(a2, b2, v, tol)
fv = f(v, v2)
For counter = 1 To maxIteration
range = b1 – a1
middle_range = (a1 + b1) / 2
tol_act = SQRT_EPSILON * Abs(x) + tol / 3
‘ tol_act = 0.000000000000001
If (Abs(x – middle_range) + range / 2 <= 2 * tol_act) Then
If (x < middle_range) Then
tmp = b1 - x
tmp = a1 - x
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
If (Abs(p) < Abs(new_step * q) And _
p > q * (a1 – x + 2 * tol_act) And _
p < q * (b1 - x - 2 * tol_act)) Then
new_step = p / q
If (Abs(new_step) < tol_act) Then
If (new_step > 0) Then
new_step = tol_act
new_step = -tol_act
t = x + new_step
a2 = fa2(t)
b2 = fb2(t)
v2 = f1minbr_var2(a2, b2, t, tol)
ft = f(t, v2)
If (ft <= fx) Then
If (t < x) Then
If (t < x) Then
If (ft <= fw Or w = x) Then
ElseIf (ft <= fv Or v = x Or v = w) Then
Next counter
optVar1 = x
a2 = fa2(optVar1)
b2 = fb2(optVar1)
optVar2 = f1minbr_var2(a2, b2, optVar1, tol)
'--------------------------------------------------------------------------
'Brent's 1-dim minimizer of var2 in f(var1,var2) given var1
' f(var1,var2) - user-defined function
' a - lower limit of var2
' b - upper limit of var2
' var1 - given value of var1
' tol- tolerance of the solution
Function f1minbr_var2(a As Double, b As Double, var1 As Double, tol As Double) As Double
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
Dim maxIteration As Integer: maxIteration = 100
r = (3# - Sqr(5#)) / 2
'assert( tol > 0 && b > a );
If (tol < 0 Or a >= b) Then
Exit Function
v = a + r * (b – a)
fv = f(var1, v)
For counter = 1 To maxIteration
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
If (x < middle_range) Then
tmp = b - x
tmp = a - x
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
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
If (Abs(new_step) < tol_act) Then
If (new_step > 0) Then
new_step = tol_act
new_step = -tol_act
t = x + new_step
ft = f(var1, t)
If (ft <= fx) Then
If (t < x) Then
If (t < x) Then
If (ft <= fw Or w = x) Then
ElseIf (ft <= fv Or v = x Or v = w) Then
Next counter
f1minbr_var2 = x
End Function
'--------------------------------------------------------------------------