МИНИСТЕРСТВО ОБРАЗОВАНИЯ РЕСПУБЛИКИ БЕЛАРУСЬ
Учреждение образования
«Гомельский государственный университет имени Франциска Скорины»
Математический факультет
ОТЧЁТ
по лабораторным работам по дисциплине
«Численные методы решения экстремальных задач»
Выполнил: студент группы ПМ-33 Соколов В.В.
Проверил: Можаровский В.В.
Гомель, 2012
Лабораторная работа №1
Найти минимум функции методом Золотого Сечения, Фибоначчи и деления пополам:
F(x)
= x*0.8
+ 
Программа:
program lab_1_1;
uses crt;
var
phi,a,b,eps,x1,x2,y1,y2: double;
k: INTEGER;
function f(x:double):double;
begin
f:=x*0.8+exp(abs(x-1.8));
end;
function min(a:double;b:double):double;
begin
if a<b then min:=a
else min:=b;
end;
begin
clrscr;
writeln('Laboratornaya rabota 1');
phi:=(1+sqrt(5))/2;
write('vvod a ->');
readln(a);
write('vvod b ->');
readln(b);
write('vvod eps ->');
readln(eps);
writeln;
x1:=b-(b-a)/phi;
x2:=a+(b-a)/phi;
y1:=f(x1);
y2:=f(x2);
{___________________________________________}
{metod zolotogo sechenia}
k:=0;
while abs(b-a)>eps do
if y1<=y2 then
begin
k:=k+1;
b:=x2;
x2:=x1;
x1:=b-(b-a)/phi;
y2:=y1;
y1:=f(x1);
end
else
begin
k:=k+1;
a:=x1;
x1:=x2;
x2:=a+(b-a)/phi;
y1:=y2;
y2:=f(x2);
end;
writeln('Rezult method Zolotogo Secheniya: ');
writeln('x--> ',min(x1,x2):8:4,' y--> ',f(min(x1,x2)):8:4);
writeln('Kol-vo iteraciq ',k);
{___________________________________________}
readln;
end.
Результат:
Программа:
program lab_1_2;
uses crt;
var
phi,a,b,x1,x2,y1,y2,q,k: double;
function f(x:double):double;
begin
f:=x*0.8+exp(abs(x-1.8));
end;
function min(a:double;b:double):double;
begin
if a<b then min:=a
else min:=b;
end;
begin
clrscr;
writeln('Laboratornaya rabota 1');
phi:=(1+sqrt(5))/2;
write('vvod a ->');
readln(a);
write('vvod b ->');
readln(b);
write('vvod q ->');
readln(q);
writeln;
x1:=b-(b-a)/phi;
x2:=a+(b-a)/phi;
y1:=f(x1);
y2:=f(x2);
{___________________________________________}
{metod fibonachchi}
Begin
k:=q;
while q<>1 do
begin
if y1<=y2 then
begin
b:=x2;
x2:=x1;
x1:=b-(b-a)/phi;
y2:=y1;
y1:=f(x1);
end
else
begin
a:=x1;
x1:=x2;
x2:=a+(b-a)/phi;
y1:=y2;
y2:=f(x2);
end;
q:=q-1;
end;
writeln('Rezalt method Fibonachi: ');
writeln('x-> ',min(x1,x2):8:4,' y-> ',f(min(x1,x2)):8:4);
writeln('Kol-vo iteraciq ',k:6:0);
End;
{__________________________________________}
readln;
end.
Результат:
Программа:
program lab_1_3;
uses crt;
var
phi,a,b,eps,x1,y1: double;
c:real;
k: INTEGER;
function f(x:double):double;
begin
f:=x*0.8+exp(abs(x-1.8));
end;
function min(a:double;b:double):double;
begin
if a<b then min:=a
else min:=b;
end;
begin
clrscr;
writeln('Laboratornaya rabota 1');
phi:=(1+sqrt(5))/2;
write('vvod a ->');
readln(a);
write('vvod b ->');
readln(b);
write('vvod eps ->');
readln(eps);
writeln;
x1:=b-(b-a)/phi;
y1:=f(x1);
{___________________________________________}
{metod delpopolam}
k:=0;
while (b-a)>eps do
begin
c:=(a+b)/2;
if f(a)*f(c)<0 then
begin
k:=k+1;
b:=c;
end
else
begin
k:=k+1;
a:=c;
end;
x1:=min(a,b);
end;
writeln('Rezult method delenia popolam: ');
writeln('x-> ',x1:8:4,' y-> ',f(x1):8:4);
writeln('Kol-vo iteraciq ',k);
{___________________________________________}
readln;
end.
Результат:
Лабораторная работа №2
Найти минимум функции методом Хука-Дживса:
График:
Программа:
program HuDj;
uses crt;
label 0,1,2,3,4,5,6,7;
var k,h,z,ps,bs,fb,fi :real;
i,j,n,fe :integer;
x,y,b,p :array[1..10] of real;
(*** Процедура,вычисляющая функцию ***)
procedure calculate;
begin
z:=sqr(sqr(x[1]))+sqr(sqr(x[2]))+2*sqr(x[1]*x[2])-4*x[1]+3;
fe:=fe+1; (*** Счетчик ***)
end;
begin
clrscr;
gotoxy(20,2);
writeln('Минимизация функции методом Хука-Дживса');
writeln;
writeln('Введите число переменных:');
readln(n);
writeln;
writeln('Введите начальную точку: ');
for i:=1 to n do
readln(x[i]);
writeln;
writeln('Введите длину шага');
readln(h);
writeln;
k:=h;
fe:=0;
for i:=1 to n do
begin
y[i]:=x[i];
p[i]:=x[i];
b[i]:=x[i];
end;
calculate;
fi:=z;
writeln('Начальное значение функции', z:2:3);
for i:=1 to n do
writeln(x[i]:2:3);
ps:=0;
bs:=1;
(*** Исследование вокруг базисной точки ***)
j:=1;
fb:=fi;
0: x[j]:=y[j]+k;
calculate;
if z<fi then goto 1;
x[j]:=y[j]-k;
calculate;
if z<fi then goto 1;
x[j]:=y[j];
goto 2;
1: y[j]:=x[j];
2: calculate;
fi:=z;
writeln('Пробный шаг',' ', z:2:3);
for i:=1 to n do
writeln(x[i]:2:3);
if j=n then goto 3;
j:=j+1;
goto 0;
3: if fi<fb-1e-08 then goto 6;
(*** После оператора 3,если функция не уменьшилась, ***)
(*** произвести поиск по образцу ***)
if (ps=1) and (bs=0) then
goto 4;
(*** Но если исследование производилось вокруг точки ***)
(*** шаблона PT,и уменьшение функции не было достигнуто,***)
(*** то изменить базисную точку в операторе 4: ***)
(*** в противном случае уменьшить длину шага в операторе***)
(*** 5: ***)
goto 5;
4: for i:=1 to n do
begin
p[i]:=b[i];
y[i]:=b[i];
x[i]:=b[i];
end;
calculate;
bs:=1;
ps:=0;
fi:=z;
fb:=z;
writeln('Замена базисной точки',' ',z:2:3);
for i:=1 to n do
writeln(x[i]:1:3);
(*** (следует за последним комментарием) ***)
(*** и провести исследование вокруг новой базисной точки ***)
j:=1;
goto 0;
5: k:=k/10;
writeln('Уменьшить длину шага');
if k<1e-08 then goto 7;
(*** Если поиск незакончен,то произвести новое ***)
(*** исследование вокруг новой базисной точки ***)
j:=1;
goto 0;
(*** Поиск по образцу ***)
6: for i:=1 to n do
begin
p[i]:=2*y[i]-b[i];
b[i]:=y[i];
x[i]:=p[i];
y[i]:=x[i];
end;
calculate;
fb:=fi;
ps:=1;
bs:=0;
fi:=z;
writeln('Поиск по образцу',' ',z:2:3);
for i:=1 to n do
writeln(x[i]:2:3);
(*** После этого произвести исследование вокруг ***)
(*** последней точки образца ***)
j:=1;
goto 0;
7: writeln('Минимум найден');
for i:=1 to n do
writeln('x(',i,')=',p[i]:2:3);
writeln;
writeln('Минимум функции равен',' ',fb:2:3);
writeln('Количество вычислений функции равно',' ',fe);
repeat until keypressed;
end.
Результат:
