IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

> Метод ломаных, экстремум
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Мужской

Репутация: -  0  +


Вот реализовал метод ломаных для поиска глобального экстремума функции.
Не могли бы Вы мен подсказать как оптимизировать мою программу,сделать её меньше.
И значение функции
у меня вычисляет 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;


Сообщение отредактировано: volvo -


Прикрепленные файлы
Прикрепленный файл  second.ZIP ( 4.12 килобайт ) Кол-во скачиваний: 252
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 12.05.2024 3:07
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name