Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 04.04.2014, 00:29   #1
nikochka
 
Регистрация: 04.04.2014
Сообщений: 5
По умолчанию Метод Нелдера -Мида

Здравствуйте! ПОМОГИТЕ! Нужен полный код метода Нелдера-Мида для многомерной задачи, а именно для задачи упруговязкопластической модели. Код может быть выполнен на делфи или С,С++,C#, необходима эта программа очень срочно
Заранее спасибо!
nikochka вне форума Ответить с цитированием
Старый 04.04.2014, 08:31   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

Цитата:
необходима эта программа очень срочно
Если я правильно понимаю, Вы хотите заказать и оплатить выполенение этой работы?
Тогда, может быть, лучше перенести эту тему во Фриланс? (я перенесу тему, если Вы действительно хотите заказать работу за вознаграждение)
Serge_Bliznykov вне форума Ответить с цитированием
Старый 04.04.2014, 09:46   #3
ZX Spectrum-128
Участник клуба
 
Регистрация: 05.11.2013
Сообщений: 1,602
По умолчанию

Держите.

Насколько точно соответствует вашей задаче не знаю.
Код:
Program SimplexMethod;
Uses Crt;

Type
TFloat = Extended;
Const
N_S = 3; { Максимальное число переменных }
Max_Float = 1.0e+4932;
Type
Vector = Array[1..Succ(N_S)] Of TFloat;
Matrix = Array[1..Succ(N_S), 1..N_S] Of TFloat;
OptimFunc = Function(N: Byte; X: Vector): TFloat;
Var
X : Vector;
H, Fmin : TFloat;
It : Integer;
{ Функция оптимизации }
Function OFunc(N: Byte; X: Vector): TFloat; FAR;
Begin
OFunc:=4*sqr(X[1]-5)+sqr(X[2]-6);
{OFunc:=2*sqr(X[1])+X[1]*X[2]+sqr(X[2]);}
End;

{**************************** *****************************************}
{* Процедура Simplex. *}
{* Оптимизация функции многих переменных методом Hелдера-Мида *}
{* *}
{* Входные параметры : *}
{* N - Число переменных; *}
{* Eps - Точность определения минимума; *}
{* X - Hа входе процедуры содержит начальное прибли- *}
{* жение к экстремуму; *}
{* H - Шаг; *}
{* IT - Допустимое число итераций; *}
{* OFunc - Внешняя процедура оптимизируемой функции. *}
{* *}
{* Выходные параметры : *}
{* X - Точка экстремума; *}
{* IT > 0 - Hормальное завершение; *}
{* < 0 - Аварийное завершение; *}
{* Fmin - Минимальное значение функции. *}
{**************************** *****************************************}
Procedure Simplex(N : Byte; OFunc : OptimFunc; Eps : TFloat;
var X : Vector; var H, Fmin : TFloat; var IT : Integer);
Var
I, J, K, Ih, Ig,IL,Itr : Integer;
Smplx : Matrix;
Xh,Xo,Xg,Xl,Xr,Xc,Xe,F : Vector;
Fh, Fl, Fg, Fo, Fr, Fe : TFloat;
S, D, Fc : TFloat;
Const
Alpha = 1.0; { Коэф. отражения }
Betta = 0.5; { Коэф. сжатия }
Gamma = 2.0; { Коэф. растяжения }
Begin
{ Hачальное приближение X[i] }
For i:=1 To N Do Smplx[1,i]:=X[i];
{ Построение симплекса на начальном приближении X[i] }
For i:=2 To Succ(N) Do
For j:=1 To N Do
If j = pred(i) Then Smplx[i,j]:=Smplx[1,j] + H
Else Smplx[i,j]:=Smplx[1,j];
{ Значение функции F[i] на вершинах симплекса }
For i:=1 To Succ(N) Do
Begin
For j:=1 To N Do X[j]:=Smplx[i,j];
F[i]:=OFunc(N, X);
End;
Itr:=0; Eps:=Abs(Eps); IT:=Abs(IT);
{ Цикл итераций }
REPEAT
{ Max и Min на вершинах }
Fh:=-Max_Float; Fl:=Max_Float;
For i:=1 To Succ(N) Do
Begin
If F[i]>Fh Then Begin Fh:=F[i]; Ih:=i End;
If F[i]<Fl Then Begin Fl:=F[i]; IL:=i End;
End;

Fg:=-Max_Float;
For i:=1 To Succ(N) Do
If (F[i]>Fg)and(i<>Ih) Then Begin Fg:=F[i]; Ig:=i End;
{ Дополнительные точки симплекса }
For j:=1 To N Do
Begin
Xo[j]:=0; { Центр тяжести }
For i:=1 To Succ(N) Do If i<>Ih Then Xo[j]:=Xo[j]+Smplx[i,j];
Xo[j]:=Xo[j]/N; { Среднее арифмет. }
Xh[j]:=Smplx[Ih,j];
Xl[j]:=Smplx[IL,j];
Xg[j]:=Smplx[Ig,j];
End;
Fo:=OFunc(N, Xo); { Значение в центре тяжести }

{ ОТРАЖЕHИЕ с коэф. Alpha}
For j:=1 To N Do Xr[j]:=Xo[j] + Alpha*(Xo[j]-Xh[j]);
Fr:=OFunc(N, Xr); { Значение в точке Xr }

If Fr<Fl Then
Begin
{ РАСТЯЖЕHИЕ с коэф. Gamma }
For j:=1 To N Do Xe[j]:=Gamma*Xr[j] + (1-Gamma)*Xo[j];
Fe:=OFunc(N, Xe);
If Fe<Fl Then
Begin
For j:=1 To N Do Smplx[Ih,j]:=Xe[j]; F[Ih]:=Fe
End Else
Begin
For j:=1 To N Do Smplx[Ih,j]:=Xr[j]; F[Ih]:=Fr
End
End Else
If Fr>Fg Then
Begin
If Fr<=Fh Then
Begin
For j:=1 To N Do Xh[j]:=Xr[j]; F[Ih]:=Fr
End;
{ СЖАТИЕ с коэф. Betta}
For j:=1 To N Do Xc[j]:=Betta*Xh[j] + (1-Betta)*Xo[j];
Fc:=OFunc(N, Xc);
If Fc>Fh Then
Begin
For i:=1 To Succ(N) Do
Begin
{ Редукция симплекса }
For j:=1 To N Do
Begin
Smplx[i,j]:=0.5*(Smplx[i,j] + Xl[j]);
X[j]:=Smplx[i,j]
End;
F[i]:=OFunc(N, X);
End
End Else
Begin
For j:=1 To N Do Smplx[Ih,j]:=Xc[j]; F[Ih]:=Fc
End
End Else
Begin
For j:=1 To N Do Smplx[Ih,j]:=Xr[j]; F[Ih]:=Fr
End;

{ Оценка стандартного отклонения (с.к. значения) }
S:=0; D:=0;
For i:=1 To Succ(N) Do Begin S:=S + F[i]; D:=D + Sqr(F[i]) End;
S:=Sqrt(Abs((D - Sqr(S)/Succ(N))/Succ(N)));
Inc(Itr);
UNTIL (S<=Eps) or (Itr>IT);

If Itr>IT Then IT:=-Itr Else IT:=Itr;
X:=XL; { Вектор решения }
Fmin:=F[IL]; { Минимальное значение функции }
End;

BEGIN
ClrScr;
X[1]:=1.5; X[2]:=0.2; { Hачальное пpиближение }
H:=0.5; It:=80;
Simplex(2, OFunc, 1.0e-8, X, H, Fmin, It);
WriteLn('Оптимум функции:');
WriteLn('X[1]=',X[1]); WriteLn('X[2]=',X[2]);
WriteLn('Fmin=',Fmin); WriteLn('It=',It);
ReadLn;
END.

Последний раз редактировалось ZX Spectrum-128; 04.04.2014 в 10:00.
ZX Spectrum-128 вне форума Ответить с цитированием
Старый 04.04.2014, 10:12   #4
nikochka
 
Регистрация: 04.04.2014
Сообщений: 5
По умолчанию

Спасибо!!А если переменных будет больше, скажем больше 10 , тогда что нужно поменяется?
nikochka вне форума Ответить с цитированием
Старый 04.04.2014, 10:17   #5
nikochka
 
Регистрация: 04.04.2014
Сообщений: 5
По умолчанию

Max_Float = 1.0e+4932;- это функция что обозначает? и скажите, пожалуйста, если у меня есть много ограничений разного типа , куда мне их нужно вписать?
nikochka вне форума Ответить с цитированием
Старый 04.04.2014, 11:24   #6
ZX Spectrum-128
Участник клуба
 
Регистрация: 05.11.2013
Сообщений: 1,602
По умолчанию

Вот здесь я вам вряд ли смогу помочь, увы.
Написано было лет 10 назад и просто не помню я, что здесь и как.
ZX Spectrum-128 вне форума Ответить с цитированием
Старый 04.04.2014, 11:30   #7
nikochka
 
Регистрация: 04.04.2014
Сообщений: 5
По умолчанию

Все равно большое спасибо Вам)
nikochka вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Метод Деформированного многогранника (М. Нелдера-Мида) FastDead Общие вопросы C/C++ 2 17.05.2015 17:57
Метод перебора, Метод дихотомии, Метод золотого сечения Delphi !!! OneBri Помощь студентам 0 03.10.2012 08:42
Delphi. Задача раскроя ткани, методом Нелдера-Мида. iidveii Фриланс 2 23.01.2012 20:34
Нахождение минимума функции методом Нелдера-МИда mitsel Фриланс 1 12.12.2011 22:07
алгоритм Нелдера-Мида ciaonataha Общие вопросы C/C++ 2 15.07.2009 16:05