Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[98.84.25.165] |
|
Сообщ.
#1
,
|
|
|
Метод наискорейшего спуска
(присоединил в архиве из-за размера исходника) Прикреплённый файлfastest.zip (3.1 Кбайт, скачиваний: 632) |
Сообщ.
#2
,
|
|
|
Оптимизация функции многих переменных методом Hелдера-Мида
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. |
Сообщ.
#3
,
|
|
|
Romtek Меня в incoming не пускают. Там глюк из-за изменения ника. А присоединиить не догадался. Сорри. Добавлено volvo877 10-nx |