Скачиваний:
48
Добавлен:
12.01.2016
Размер:
1.96 Кб
Скачать
Function f(x() As Double) As Double
f = 100 * (x(2) - x(1) ^ 2) ^ 2 + (1 - x(1)) ^ 2
End Function
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
Sub симплексный_метод_с_регулярным_симплексом()
Const n = 2, e = 0.000000000001, r = -1
Dim x(-1 To n + 1, 1 To n) As Double, L As Double
Dim f(-1 To n + 1) As Double, i As Integer, m As Integer
L = 1: For j = 1 To n: x(1, j) = -5: 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(m) < f(i) Then m = i
Next i
For j = 1 To n
x(0, j) = 0
For i = 1 To n + 1
If i <> m 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(r) = fns(x, r)
If f(r) < f(m) Then
For j = 1 To n
x(m, j) = x(r, j)
Next j
f(m) = f(r)
Else
L = L / 2
m = 1
For i = 2 To n + 1: If f(m) > f(i) Then m = i
Next i
If m <> 1 Then
For j = 1 To n
x(1, j) = x(m, j)
Next j
f(1) = f(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
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