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 килобайт ) Кол-во скачиваний: 249
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2





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

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


Вы мне скажите.Почему мне приходится писать
Код

while (abs(Uold-Ucur)>=Eps) or (i<30) do

хотя переменная i ни на что здесь не влияет и итераций происходит меньше!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Цитата(Falex @ 10.03.2006 16:49)
переменная i ни на что здесь не влияет и итераций происходит меньше!

Всегда? Хочешь очень сильно удивиться? Задай точность = 0.00000000001 и поменяй приведенный тобой фрагмент на
while (abs(Uold-Ucur)>=Eps) or (i<80) do
Сколько итераций получишь?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





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

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


Получается 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-количество итераций),т.е. там постоянно на каждой итерации происходит лишнее вычисление функции.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Цитата(alglib.sources.ru/extremums/pijavsky.php)
К недостаткам метода можно отнести то, что он малоэффективен при минимизации значения функции, близкой к константе.
Вот для того, чтобы быть уверенным, что при использовании, например, такой функции:
function func(x: real) :real;
begin
Result := 1;
inc(i_func);
end;
(ну, или почти константы) ты не войдешь в "вечный" цикл, ты и перестраховываешься, ограничивая максимально возможное число итераций...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6





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

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


Ну а если убрать это условие,то будет всегда ответ 6.2 и итераций 2,хотя ответ совершенно неправильный.Т.е. получается,что
я не только перестраховываюсь,но и увеличиваю количество повторений.
Ведь должно быть написано просто:
Код

while (abs(Uold-Ucur)>=Eps) do //это и есть критерий.Остального быть не должно!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Внимание, вопрос на засыпку (при K изначально равном 0):
  u1:=Points[k-1].U;i1:=k-1; // Ничего подозрительного не замечаешь ?
u2:=Points[k].U;i2:=k;
while (abs(u1-u2)>=Eps) do ...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8





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

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


При k=1 тоже всё работает.Я это поменял.Спасибо.Но это никак не решает мой предыдущий вопрос!
Да я бы вообще если честно переписал код в обработчике события нажатия этой кнопки,но не знаю как.
Ты мне не поможешь?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9





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

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


Ну как.Может поможушь всю программу переделать,чтобы красиво код выглядел.?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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