Министерство образования и науки Российской Федерации
Пермский государственный технический университет
Кафедра ИТАС
Практическая работа №2.
Многомерные методы прямого поиска
(Метод Хука-Дживса).
Вариант №1.
Выполнила студентка Дьякова О.Р.
Группа АСУ-02-2.
Принял Гольдштейн А.Л.
Пермь 2005
Листинг программы:
function Myfunc(X1,X2:real;RealValue:boolean=False):real;
//Рабочая функция
begin
Result:=8*Sqr(X1)+4*X1*X2+5*Sqr(X2);
if not(MainForm.Min or RealValue) then Result:=-Result;
end;
//метод Хука-Дживса
procedure TMainForm.HoockJeeves(Sender: TObject);
var x11,x12,x21,x22,work1,work2:real;
work,i:longword;
begin
Screen.Cursor:=crHourGlass; t:=GetTickCount; RepForm.Show;
with RepForm.RepMemo.Lines do
begin
Append('Решение задачи методом Хука-Дживса');
Append('Начальные данные:');
Append('X1= '+FloatToStr(bX1));
Append('X2= '+FloatToStr(bX2));
Append('Eps= '+FloatToStr(Eps)+#13#10);
end;
i:=0; x21:=bX1; work1:=bX1; x22:=bX2; work2:=bX2;
try
miRepaint.Click;
with Graph.Canvas do
begin
Pen.Style:=psSolid; Pen.Width:=2; MoveTo(Real2X(t1),Real2Y(t2));
end;
repeat
Inc(i); x11:=x21; x12:=x22; x21:=MinX1(work1,work2); x22:=MinX2(x21, work2);
with Graph.Canvas do
begin
Pen.Color:=clGreen;
LineTo(Real2X(x21),Real2Y(work2));
LineTo(Real2X(x21),Real2Y(x22));
work1:=x11; work2:=x12;
if not MinTempY (work1, work2,x21,x22) then Exit;
Pen.Color:=clRed;
LineTo(Real2X(x11),Real2Y(x12));
LineTo(Real2X(work1),Real2Y(work2));
end;
if miDebug.Checked then
with RepForm.RepMemo.Lines do
begin
Append('Шаг '+IntToStr(i)+'; '+FloatToStr((GetTickCount- work)/1000)+' сек');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('yX1= '+FloatToStr(work1));
Append('yX2= '+FloatToStr(work2));
Append('delta= '+FloatToStr(Hypot(x21-x11,x22-x12)));
Append('----------------------------------------'); end;
until Hypot(x21-x11,x22-x12)<Eps;
with RepForm.RepMemo.Lines do
begin Append('Задача решена за '+IntToStr(i)+' шаг(а,ов); '+FloatToStr((GetTickCount- work)/1000)+' сек');
Append('Решение:');
Append('X1= '+FloatToStr(x21));
Append('X2= '+FloatToStr(x22));
Append('F(X1,X2)= '+FloatToStr(F(x21,x22,True)));
Append('delta= '+FloatToStr(Hypot(x21-x11,x22-x12)));
Append('========================================'#13#10);
end; finally Screen.Cursor:=crDefault; end; end;
//одномерная минимизация методом деления пополам
functionTMainForm.MinX1(X1,X2:real):real;
var x,dx:real;
begin
x:=X1; dx:=Eps*200;
while Abs(dx)>=Eps/10 do
begin
dx:=-dx/2; while Myfunc(x+dx,X2)<Myfunc(x,X2) do x:=x+dx; end; Result:=x;
end;
//одномерная минимизация методом деления пополам
functionTMainForm.MinX2(X1,X2:real):real;
var x,dx:real;
begin
x:=X2; dx:=Eps*200;
while Abs(dx)>=Eps/10 do
begin
dx:=-dx/2; while Myfunc(X1,x+dx)<Myfunc(X1,x) do x:=x+dx; end; Result:=x;
end;
//движение по образцу(ускоряющий шаг)
function TMainForm.MinTempY(var X1, X2: real; x, y: real):boolean;
var work,dx,cosin,st:real;
i:integer;
begin
Result:=True;
if x=X1 then begin X1:=MinX1(X1,X2); Exit; end;
if y=X2 then begin X2:=MinX2(X1,X2); Exit; end;
cosin:=(y-X2)/(x-X1); st:=X2-cosin*X1; dx:=Eps*200; work:=X1;
while Hypot(dx,dx*cosin)>=Eps do begin dx:=-dx/2; i:=0;
while Myfunc(work+dx,(work+dx)*cosin+st)<Myfunc(work,work*cosin+st) do
begin Inc(i); work:=work+dx;
if (i mod 1000000)=0 then
begin
ifMessageDlg('Экстремум не найден за '+IntToStr(i)+' итераций!'#13#10+
'Остановить выполнение программы?',mtWarning,[mbYes,mbNo],0)=mrYes then
begin
Result:=False; Exit; end; end; end; end;
X1:=work; X2:=work*cosin+st; end;
Примеры работы метода:
1.
