Function f(x As Double) As Double
f = x * x - x
End Function
Sub метод_Параболы()
Const e = 0.00001
Dim x(1 To 4) As Double, ff(1 To 4) As Double, h As Double, _
j As Integer, k As Integer
x(1) = -1.1: h = 0.4
ff(1) = f(x(1))
Do
x(2) = x(1) + h: ff(2) = f(x(2))
If ff(1) < ff(2) Then x(3) = x(1) - h Else x(3) = x(1) + 2 * h
ff(3) = f(x(3)): h = 2 * h
Loop While ff(3) < ff(1) And ff(3) < ff(2)
Do
x(4) = (x(1) + x(2)) / 2 + 0.5 * (ff(1) - ff(2)) * (x(2) - x(3)) * (x(3) - x(1)) / ((x(2) - x(3)) * ff(1) + (x(3) - x(1)) * ff(2) + (x(1) - x(2)) * ff(3))
ff(4) = f(x(4))
For j = 1 To 3
For k = j + 1 To 4
If ff(j) > ff(k) Then x(k) = x(j) + x(k): x(j) = x(k) - x(j): x(k) = x(k) - x(j): ff(k) = ff(j) + ff(k): _
ff(j) = ff(k) - ff(j): ff(k) = ff(k) - ff(j)
Next k
Next j
If (x(4) < x(1) And x(1) < x(2) And x(1) < x(3)) Or (x(4) > x(1) And x(1) > x(2) And x(1) > x(3)) _
Then x(3) = x(4): ff(3) = ff(4)
Loop While ff(2) - ff(1) > e
Debug.Print x(1), ff(1)
End Sub