Вот реализовал метод ломаных для поиска глобального экстремума функции. Не могли бы Вы мен подсказать как оптимизировать мою программу,сделать её меньше. И значение функции у меня вычисляет 2*N+2 раз,хотя должно быть N+2.Спасибо.
Код
type TMyData = record U:real; J: real; end ... var MCut: TMCut; min,L,a,b,Ucur,Uold: real; Icur,Iold,i_func: integer; PtsData: array of TMyData;
implementation
{$R *.dfm}
function Getfunc(x: real) :real; begin Result:=7.667*sin(5.983*x)-6*x; inc(i_func); end;
function GetL(m:integer):real; var i:integer;h,temp_L:real; v,Q:array of real; begin SetLength(v,m+1); SetLength(Q,m+1); i_func:=0; end;
function GetIntersect(i: integer): real; begin GetIntersect:=(PtsData[i].J-PtsData[i+1].J+51.8716171862423 * (PtsData[i].U+PtsData[i+1].U))/(2*51.8716171862423); end;
procedure InsertNew(X: real); var i,j: integer; begin i:=0; while PtsData[i].U<X do inc(i); SetLength(PtsData,Length(PtsData)+1); for j:=Length(PtsData)-1 downto i+1 do begin PtsData[j].U:=PtsData[j-1].U; PtsData[j].J:=PtsData[j-1].J; end; PtsData[i].U:=X; PtsData[i].J:=GetFunc(X); end;
procedure SortIt; var j: integer; begin for j:=0 to Length(PtsData) do begin if PtsData[j].U>PtsData[j+1].U then begin PtsData[j].U:=PtsData[j].U+PtsData[j+1].U; PtsData[j+1].U:=PtsData[j].U-PtsData[j+1].U; PtsData[j].U:=PtsData[j].U-PtsData[j+1].U; PtsData[j].J:=PtsData[j].U+PtsData[j+1].J; PtsData[j+1].J:=PtsData[j].U-PtsData[j+1].J; PtsData[j].J:=PtsData[j].U-PtsData[j+1].J; end; end; end; function GetMinIndex: integer; var i,j: integer; min: real; begin min:=PtsData[0].J; for i:=1 to Length(PtsData)-1 do begin if PtsData[i].J<min then begin min:=PtsData[i].J; j:=i; end; end; GetMinIndex:=j; end; procedure TMCut.BitBtn1Click(Sender: TObject); var Un,Un2,Eps: real; i,k,j,len: integer; begin SetLength(PtsData,2); a:=StrToFloat(Edit1.Text); b:=StrToFloat(Edit2.Text); Eps:=abs(StrToFloat(Edit5.Text)); GetL(10000); PtsData[0].U:=(a+b)/2; PtsData[0].J:=GetFunc(PtsData[0].U); PtsData[1].U:=b; PtsData[1].J:=GetFunc(PtsData[1].U); k:=1; Uold:=PtsData[k-1].U; Ucur:=PtsData[k].U; Icur:=k; Iold:=k-1; i:=0; while (abs(Uold-Ucur)>=Eps) or (i<30) do begin inc(i); if k<Length(PtsData) then begin Un:=GetIntersect(k-1); Un2:=GetIntersect(k); end; InsertNew(Un); InsertNew(Un2); k:=GetMinIndex; if (abs(Uold-Ucur)/2<Eps) and ((Uold-Ucur)<>0) then break; begin Uold:=Ucur; Iold:=Icur; Icur:=k; Ucur:=PtsData[k].U; end; end; Memo1.Lines.Add('решение = '+Format('%2.8f',[PtsData[k].u])); Memo1.Lines.Add('функция = '+Format('%2.8f',[PtsData[k].j])); Memo1.Lines.Add('итерации = '+IntToStr(i)); Memo1.Lines.Add('вычисление функции = '+IntToStr(i_func)); end;
хотя переменная i ни на что здесь не влияет и итераций происходит меньше!
Автор: volvo 10.03.2006 22:13
Цитата(Falex @ 10.03.2006 16:49)
переменная i ни на что здесь не влияет и итераций происходит меньше!
Всегда? Хочешь очень сильно удивиться? Задай точность = 0.00000000001 и поменяй приведенный тобой фрагмент на
while (abs(Uold-Ucur)>=Eps) or (i<80) do
Сколько итераций получишь?
Автор: Falex 10.03.2006 23:50
Получается 41 итерация.Нет.Я знаю,что из-за точности количество итераций растёт.Но почему мне приходиться писать такое условие:
Код
while (abs(Uold-Ucur)>=Eps) or (i<80) do
Хотя просто должно быть условие:
Код
while (abs(Uold-Ucur)>=Eps) do
Ведь i используется просто для подсчёта количества итераций. А вот ещё вопрос:как мне уменьшить количество вычисления функций в блоке while...do.Должно быть вычислений функции N+2,а не 2*N+2 (N-количество итераций),т.е. там постоянно на каждой итерации происходит лишнее вычисление функции.
Автор: volvo 10.03.2006 23:57
Цитата(alglib.sources.ru/extremums/pijavsky.php)
К недостаткам метода можно отнести то, что он малоэффективен при минимизации значения функции, близкой к константе.
Вот для того, чтобы быть уверенным, что при использовании, например, такой функции:
function func(x: real) :real; begin Result := 1; inc(i_func); end;
(ну, или почти константы) ты не войдешь в "вечный" цикл, ты и перестраховываешься, ограничивая максимально возможное число итераций...
Автор: Falex 11.03.2006 0:24
Ну а если убрать это условие,то будет всегда ответ 6.2 и итераций 2,хотя ответ совершенно неправильный.Т.е. получается,что я не только перестраховываюсь,но и увеличиваю количество повторений. Ведь должно быть написано просто:
Код
while (abs(Uold-Ucur)>=Eps) do //это и есть критерий.Остального быть не должно!
Автор: volvo 11.03.2006 0:48
Внимание, вопрос на засыпку (при K изначально равном 0):
u1:=Points[k-1].U;i1:=k-1; // Ничего подозрительного не замечаешь ? u2:=Points[k].U;i2:=k; while (abs(u1-u2)>=Eps) do ...
Автор: Falex 11.03.2006 1:37
При k=1 тоже всё работает.Я это поменял.Спасибо.Но это никак не решает мой предыдущий вопрос! Да я бы вообще если честно переписал код в обработчике события нажатия этой кнопки,но не знаю как. Ты мне не поможешь?
Автор: Falex 11.03.2006 16:48
Ну как.Может поможушь всю программу переделать,чтобы красиво код выглядел.?