Скачиваний:
48
Добавлен:
12.01.2016
Размер:
2.75 Кб
Скачать
Function fns(x() As Double, i As Integer) As Double
fns = 100 * (x(i, 2) - x(i, 1) ^ 2) ^ 2 + (1 - x(i, 1)) ^ 2
End Function
Function g(x() As Double, i As Integer) As Boolean
g = True
g = (Abs(x(i, 1)) ^ 1.1 < 1000000# And x(i, 2) ^ 2 + 10 < 10000000#) And g
End Function
Sub явные_ограничения(x() As Double, L() As Double, R() As Double, _
j As Integer, e As Double)
If x(-1, j) < L(j) Then x(-1, j) = L(j) + e / 2
If x(-1, j) > R(j) Then x(-1, j) = R(j) - e / 2
End Sub
Function сходимость(f() As Double, k As Integer, e As Double) As Boolean
Dim i As Integer
f(0) = 0
For i = 1 To k
f(0) = f(0) + f(i) / k
Next i
f(-1) = 0
For i = 1 To k
f(-1) = f(-1) + (f(i) - f(0)) ^ 2 / k
Next i
f(-1) = Sqr(f(-1))
If f(-1) > e Then сходимость = True
End Function
Sub сжатие(x() As Double, L() As Double, R() As Double, n As Integer, _
B As Double, e As Double, стоп As Boolean)
Dim j As Integer
стоп = False
For j = 1 To n
x(-1, j) = (x(-1, j) + x(0, j)) * B
явные_ограничения x, L, R, j, e
If Abs(x(-1, j) - x(0, j)) < e Then
стоп = True
Exit Sub
End If
Next j
End Sub
Sub замена(Rd As Integer, Wr As Integer, x() As Double, f() As Double, _
n As Integer)
Dim j As Integer
For j = 1 To n
x(Wr, j) = x(Rd, j)
Next j
f(Wr) = f(Rd)
End Sub
Sub печать(x() As Double, f() As Double, n As Integer, k As Integer)
Dim i As Integer, j As Integer, L As Integer
L = 1
For i = 2 To k
If f(i) < f(L) Then L = i
Next i
For j = 1 To n
Debug.Print x(L, j);: Next j
Debug.Print f(L)
End Sub
Function поиск(x() As Double, f() As Double, L() As Double, R() As Double, _
n As Integer, k As Integer, e As Double, A As Double, B As Double) As Boolean
Dim i As Integer, j As Integer, H As Integer, стоп As Boolean
Do
H = 1
For i = 2 To k
If f(i) > f(H) Then H = i
Next i
For j = 1 To n
x(0, j) = 0
For i = 1 To k
If i <> H Then x(0, j) = x(0, j) + x(i, j) / (k - 1)
Next i
x(-1, j) = (1 + A) * x(0, j) - A * x(H, j)
явные_ограничения x, L, R, j, e
Next j
Do
While Not (g(x, -1))
сжатие x, L, R, n, B, e, стоп
Wend
f(-1) = fns(x, -1)
If f(-1) < f(H) Then
Exit Do
Else
сжатие x, L, R, n, B, e, стоп
If стоп Then
поиск = True
Exit Function
End If
End If
Loop
замена -1, H, x, f, n
Loop While сходимость(f, k, e)
End Function
Sub комплексный_метод()
Const n = 2, k = n * 2, e = 0.0000001, A = 1.3, B = 0.5
Dim x(-1 To k, 1 To n) As Double, f(-1 To k) As Double, _
i As Integer, j As Integer, L(1 To n) As Double, R(1 To n) As Double
For j = 1 To n
L(j) = -2
R(j) = 10
Next j
Do
For i = 1 To k
Do
For j = 1 To n
x(i, j) = L(j) + Rnd * (R(j) - L(j))
Next j
Loop While Not (g(x, i))
f(i) = fns(x, i)
Next i
Loop While поиск(x, f, L, R, n, k, e, A, B)
печать x, f, n, k
End Sub