Matematicheskie_metody / Мат. методы. 2 семестр(2 модуль) / симплексный метод с деформируемым многогранником(симплексом)

Sub симплексный_метод_с_деформируемым_многогранником()
Const n = 2, e0 = 0.0000000001, L0 = 1, Al = -1, Bt = 0.5, Ga = 1 / Bt, R = -1, e = -2, C = -3
Dim x(-3 To n + 1, 1 To n) As Double, f(-3 To n + 1) As Double, i As Integer, _
j As Integer, h As Integer, g As Integer, L As Integer
For j = 1 To n: x(1, j) = -5: Next j
симплекс x, n, L0
For i = 1 To n + 1
f(i) = fns(x, i)
Next i
Do
h = 1: L = 1
For i = 2 To n + 1
If f(i) > f(h) Then h = i
If f(i) < f(L) Then L = i
Next i
g = L
For i = 1 To n + 1
If i <> h And f(i) <> f(g) Then
g = i
End If
Next i
For j = 1 To n
x(0, j) = 0
For i = 1 To n + 1
If i <> h Then x(0, j) = x(0, j) + x(i, j) / n
Next i, j
преобразовать h, R, Al, n, x, f
If f(R) < f(g) Then
If f(R) < f(L) Then
преобразовать R, e, Ga, n, x, f
If f(e) < f(L) Then замена e, h, n, x, f Else замена R, h, n, x, f
Else
замена R, h, n, x, f
End If
Else
If f(R) < f(h) Then замена R, h, n, x, f
преобразовать h, C, Bt, n, x, f
If f(C) < f(h) Then
замена C, h, n, x, f
Else
гомотетия L, n, x, f
End If
End If
Loop While сходимость(f, n, e0)
печать_результата x, f, n
End Sub
Sub преобразовать(Rd As Integer, Wr As Integer, k As Double, n As Integer, _
x() As Double, f() As Double)
Dim j As Integer
For j = 1 To n
x(Wr, j) = k * x(Rd, j) + (1 - k) * x(0, j)
Next j
f(Wr) = fns(x, Wr)
End Sub
Sub замена(Rd As Integer, Wr As Integer, n As Integer, x() As Double, f() As Double)
Dim j As Integer
For j = 1 To n
x(Wr, j) = x(Rd, j)
Next j
f(Wr) = f(Rd)
End Sub
Sub гомотетия(L As Integer, n As Integer, x() As Double, f() As Double)
Dim i As Integer, j As Integer
For i = 1 To n + 1
If i <> L Then
For j = 1 To n
x(i, j) = (x(i, j) + x(L, j)) / 2
Next j
f(i) = fns(x, i)
End If
Next i
End Sub
Sub симплекс(x() As Double, n As Integer, L As Double)
Dim i As Integer, j As Integer, k As Integer
For j = 1 To n
For i = 2 To j
x(i, j) = x(1, j)
Next i
x(i, j) = x(j, j) + L * Sqr((j + 1) / (2 * j))
For i = j + 2 To n + 1
x(i, j) = 0
For k = 1 To i - 1
x(i, j) = x(i, j) + x(k, j) / (i - 1)
Next k
Next i
Next j
End Sub
Function fns(x() As Double, m As Integer) As Double
fns = 100 * (x(m, 2) - x(m, 1) ^ 2) ^ 2 + (1 - x(m, 1)) ^ 2
End Function
Function сходимость(f() As Double, n As Integer, e As Double) As Boolean
Dim i As Integer, s As Double
f(0) = 0
s = 0
For i = 1 To n + 1
f(0) = f(0) + f(i) / (n + 1): Next i
For i = 1 To n + 1: s = s + (f(i) - f(0)) ^ 2 / (n + 1): Next i
If Sqr(s) > e Then сходимость = True Else сходимость = False
End Function
Sub печать_результата(x() As Double, f() As Double, n As Integer)
Dim j As Integer
For j = 1 To n
Debug.Print x(1, j);: Next j
Debug.Print f(1)
End Sub