Модераторы: mihanik
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Симплексный метод с регулярным симплексом, Помогите отладить программу,недолго!!! 
:(
    Опции темы
NEOSPRINT
Дата 22.5.2016, 21:55 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 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 )
Присоединённый файл  _e_60VjtvFo.jpg 185,36 Kb
PM MAIL   Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Программирование, связанное с MS Office"
mihanik staruha

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами



  • Несанкционированная реклама на форуме запрещена
  • Пожалуйста, давайте своим темам осмысленный, информативный заголовок. Вопль "Помогите!" таковым не является.
  • Чем полнее и яснее Вы изложите проблему, тем быстрее мы её решим.
  • Оставляйте свои записи в "Книге отзывов о работе администрации"
  • А вот тут лежит FAQ нашего подраздела


Если Вам понравилась атмосфера форума, заходите к нам чаще!
С уважением mihanik и staruha.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Программирование, связанное с MS Office | Следующая тема »


 




[ Время генерации скрипта: 0.0619 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.