Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Программирование, связанное с MS Office > Симплексный метод с регулярным симплексом

Автор: NEOSPRINT 22.5.2016, 21:55

Здравствуйте, дорогие форумчане! Прошу о помощи в отладке программы, ну не особо я шарю в этом, программа вроде построена правильно согласно алгоритму, но надо отладить чтобы правильные значения выдавала, в ответе должно получиться(0).Прилагаю фото алгоритма решения.Функция (fn = 100 * (x(2) - x(1) ^ 2) ^ 2 + (1 - x(1) ^ 2)).Заранее спасибо тем, кто хоть как-то поможет!!

Function fn(x() As Double) As Double
fn = 100 * (x(2) - x(1) ^ 2) ^ 2 + (1 - x(1) ^ 2)
End Function
Sub СМРС()
Const e = 0.0000000001, n = 2, R = -1
Dim x(-1 To n + 1, 1 To n) As Double, i As Integer, j As Integer, L As Double, F(-1 To n + 1) As Double, M As Integer
L = 1
For j = 1 To n
x(1, j) = -3
Next j
симплекс x, n, L
For i = 1 To n + 1
F(i) = fns(x, i)
Next i
Do
    M = 1
    For i = 2 To n + 1
    If F(i) > F(M) Then M = i
    Next i
    For j = 1 To n
    x(0, j) = 0
    For i = 1 To n + 1
    If M <> i Then x(0, j) = x(0, j) + x(i, j) / n
    Next i
    x(R, j) = 2 * x(0, j) - x(M, j)
    Next j
    F® = fns(x, R)
    If F® < F(M) Then
    замена R, M, x, F, n
    Else
    x(n, M) = x(n, R)
    F(M) = F®
    M = 1
    For i = 2 To n + 1
    If F® >= F(M) Then M = x(n, 1)
    Next i
    L = L / 2
    If M > 1 Then
    замена M, 1, x, F, n
    x(n, 1) = x(n, M)
    End If
    симплекс x, n, L
    For i = 2 To n + 1
    F(i) = fns(x, i)
    Next i
    End If
Loop While сходимость(F, n, e)
печать_результата x, F, n
End Sub
Sub симплекс(x() As Double, n As Integer, L As Double)
Dim j As Integer, i 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, i, j
End Sub
Function fns(x() As Double, n As Integer) As Double
fns = 100 * (x(n, 2) - x(n, 1) ^ 2) ^ 2 + (1 - x(n, 1)) ^ 2
End Function
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
Function сходимость(F() As Double, n As Integer, e As Double) As Boolean
Dim i As Integer, s As Double
F(0) = 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(0) - F(i)) ^ 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