![]() |
Модераторы: mihanik |
![]() ![]() ![]() |
|
NEOSPRINT |
|
|||
Новичок Профиль Группа: Участник Сообщений: 1 Регистрация: 22.5.2016 Репутация: нет Всего: нет |
Здравствуйте, дорогие форумчане! Прошу о помощи в отладке программы, ну не особо я шарю в этом, программа вроде построена правильно согласно алгоритму, но надо отладить чтобы правильные значения выдавала, в ответе должно получиться(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 Это сообщение отредактировал(а) NEOSPRINT - 22.5.2016, 21:57 Присоединённый файл ( Кол-во скачиваний: 0 ) ![]() |
|||
|
||||
![]() ![]() ![]() |
Правила форума "Программирование, связанное с MS Office" | |
|
Запрещается! 1. Публиковать ссылки на вскрытые компоненты 2. Обсуждать взлом компонентов и делиться вскрытыми компонентами
Если Вам понравилась атмосфера форума, заходите к нам чаще!
|
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей) | |
0 Пользователей: | |
« Предыдущая тема | Программирование, связанное с MS Office | Следующая тема » |
|
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности Powered by Invision Power Board(R) 1.3 © 2003 IPS, Inc. |