Скачиваний:
48
Добавлен:
12.01.2016
Размер:
1.81 Кб
Скачать
Sub градиент(x() As Double, G() As Double)
G(1) = -400 * x(2) * x(1) + 400 * x(1) ^ 3 - 2 + 2 * x(1)
G(2) = 200 * x(2) - 200 * x(1) ^ 2
End Sub
Function сходимость(G() As Double, n As Integer, e As Double) As Double
Dim i As Integer
G(0) = 0
For i = 1 To n
G(0) = G(0) + G(i) ^ 2
Next i
G(0) = Sqr(G(0))
If G(0) > e Then сходимость = True
End Function
Function fn(x() As Double) As Double
fn = 100 * (x(2) - x(1) ^ 2) ^ 2 + (1 - x(1)) ^ 2
End Function
Sub метод_наискорейшего_спуска()
Const n = 2, e = 0.0000001, e1 = 0.1
Dim lm As Double, x(1 To n) As Double, y(1 To n) As Double, _
i As Integer, d(n) As Double, L(4) As Double, f(4) As Double, _
g2 As Double, G(n) As Double
lm = 1
For i = 1 To n
x(i) = -5
y(i) = x(i)
Next i
градиент x, G
While сходимость(G, n, e)
For i = 1 To n
d(i) = -G(i) / G(0)
Next i
L(1) = 0: f(1) = fn(y)
lm = lm / 2
Do
lm = lm * 2
L(3) = lm + L(1)
For i = 1 To n
x(i) = y(i) + L(3) * d(i)
Next i
f(3) = fn(x)
градиент x, G
g2 = 0
For i = 1 To n
g2 = g2 + G(i) * d(i)
Next i
Loop While f(3) < f(1) And g2 < 0
поиск x, y, d, f, L, n, lm, e1
For i = 1 To n
x(i) = y(i) + L(0) * d(i)
y(i) = x(i)
Next i
lm = lm / 2
градиент x, G
Wend
For i = 1 To n
Debug.Print x(i);: Next i: Debug.Print fn(x)
End Sub
Sub поиск(x() As Double, y() As Double, d() As Double, f() As Double, L() As Double, _
n As Integer, lm As Double, e1 As Double)
Const tau = (1 + 5 ^ 0.5) / 2
Dim t As Double, i As Integer
t = 1
Do
t = t * tau
L(0) = lm / t: L(4) = L(3) - L(0)
L(2) = L(1) + L(0)
For i = 1 To n
x(i) = y(i) + L(2) * d(i)
Next i
f(2) = fn(x)
For i = 1 To n
x(i) = y(i) + L(4) * d(i)
Next i
f(4) = fn(x)
If f(4) < f(2) Then
L(3) = L(2)
L(0) = L(4)
Else
L(1) = L(4)
L(0) = L(2)
End If
Loop While L(3) - L(1) > e1
End Sub