Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
alex227
0 / 0 / 0
Регистрация: 09.06.2017
Сообщений: 1
#1

Симплесный метод с регулярным симплексом - VBA

09.06.2017, 16:48. Просмотров 120. Ответов 0

Требуется составить задачу для нахождения минимума функции. При выполнении выдает ошибку subscript out of range в строчке c функцией Fn. Прошу помочь. Заранее спасибо
http://www.cyberforum.ru/vba/thread1511255.html

Visual Basic
1
2
3
Function Fn(x() As Double, i As Integer) As Double
Fn = (x(1) + 10 * x(2)) ^ 2 + 5 * (x(3) - x(4)) ^ 2 + (x(2) - 2 * x(3)) ^ 4 + 10 * (x(1) - x(4)) ^ 4
End Function
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub СМРС()
Const n = 2, Epsilon = 1E-16, R = -1, Alfa = -1#
Dim L As Double, x(-1 To n + 1, 1 To n) As Double, i As Integer, _
j As Integer, F(-1 To n + 1) As Double, M As Integer
L = 1
For j = 1 To n
x(1, j) = -5
Next j
построение_симплекса x, n, L
вычисление_функции_в_вершинах_симплекса n, x, F, 0
Do
M = наибольшая_вершина(F, n)
центр_тяжести x, n, M
преобразовать M, R, Alfa, x, F, n
If F(R) < F(M) Then
преобразовать R, M, 1, x, F, n
Else
L = L / 2
M = наименьшая_вершина(F, n)
преобразовать M, 1, 1, x, F, n
построение_симплекса x, n, L
вычисление_функции_в_вершинах_симплекса n, x, F, 1
End If
iter = iter + 1
Loop While сходимость_не_достигнута(F, n, Epsilon)
печать_результата x, F, n
End Sub
Visual Basic
1
2
3
4
5
6
7
Sub печать_результата(x() As Double, F() As Double, n As Integer)
Dim j As Integer, M As Integer
M = наименьшая_вершина(F, n)
For j = 1 To n
Debug.Print x(M, j);
Next j
End Sub
Visual Basic
1
2
3
4
5
6
7
Function наибольшая_вершина(F() As Double, n As Integer) As Integer
Dim i As Integer
наибольшая_вершина = 1
For i = 2 To n + 1
If F(наибольшая_вершина) < F(i) Then наибольшая_вершина = i
Next i
End Function
Visual Basic
1
2
3
4
5
6
7
8
Sub преобразовать(Rd As Integer, Wr As Integer, K As Double, _
x() As Double, F() As Double, n As Integer)
Dim j As Integer
For j = 1 To n
x(Wr, j) = K * x(Rd, j) + (1 - K) * x(0, j)
Next j
If K <> 1 Then F(Wr) = Fn(x, Wr) Else F(Wr) = F(Rd)
End Sub
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Function сходимость_не_достигнута(F() As Double, n As Integer, _
E As Double) As Boolean
Dim FSR As Double, i As Integer, S As Double
For i = 1 To n + 1
FSR = FSR + F(i) / (n + 1)
Next i
For i = 1 To n + 1
S = S + (F(i) - FSR) ^ 2 / (n + 1)
Next i
If Sqr(S) > E Then сходимость_не_достигнута = True
End Function
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
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(i / (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
Visual Basic
1
2
3
4
5
6
Sub вычисление_функции_в_вершинах_симплекса(n As Integer, x() As Double, F() As Double, не_вычислять As Integer)
Dim i As Integer
For i = 1 To n + 1
If i <> не_вычислять Then F(i) = Fn(x, i)
Next i
End Sub
Visual Basic
1
2
3
4
5
6
7
8
9
Sub центр_тяжести(x() As Double, n As Integer, M As Integer)
Dim i As Integer, j As Integer
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
Next j
End Sub
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
09.06.2017, 16:48
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Симплесный метод с регулярным симплексом (VBA):

СЛАУ. Метод обратной матрицы, метод Гаусса, метод Крамера, метод Зейделя
Помогите ребят. Не могу построить алгоритмы для этих методов Язык C++

с регулярным выражением.
Имеем текст youtube.com/watch?v=LOZuxwVk7TU&amp;ob=av2em нужно получить то что...

Вопрос по регулярным выражениям
Добрый день! Подскажите, как выбрать из строки &quot;Цвет: ARTHUR_1 Ширина (м): 3...

Запутался с регулярным выражением
Смотрел SED'овский туториал и не могу понять последний пример. Что-то вообще...

Вопрос по регулярным выражениям.
Допустим у меня есть строка (для удобства восприятия разобью ее на строчки, но...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
09.06.2017, 16:48
Привет! Вот еще темы с решениями:

Вопрос по регулярным выражениям
Прошу помочь в такой вот легкой задачке. Уже второй день бьюсь с проблемой....

ФИО регулярным выражением
Добрый день! Нужно сделать программу которая бы используя ТОЛЬКО регулярные...

Поиск по регулярным выражениям
Наткнулся на ХХ на вот такой вот код:var field = $('#list').find('option'); ...

Не получаеться с регулярным выражением
Здравствуйте Подскажите пожалуйста как средствами perl сделать следующее:...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru