Цель задания: приобрести практические навыки разработки алгоритмов и программ оптимизации многомерных функций методами ненулевого порядка, в частности методом прямого поиска.
Рисунок 8 – блок-схема подпрограммы циклического изменения координат базисной точки
 |
Рисунок 9 – Блок-схема метода прямого поиска
Индивидуальное задание.
Найдите минимум функции 
методом прямого поиска, выбрав в Хо(3, -1, 2), а потом Хо(-3, 1, -2).
Алгоритм с помощью которого проводилась оптимизация функции изображена на рисунках 8, 9 в виде блок-схем.
Решение задачи на ЭВМ.
На рисунках 10, 11 изображены результаты оптимизации на ЭВМ при различных начальных условиях
Рисунок 10 – результаты и траектория движения базиса при Хо(3, -1, 2)
Рисунок 11 – результаты при Хо(-3,1, -2)
Вывод: В ходе работы при изменении начальных условий было выявлено, что приближение начальных условий к оптимальным значениям количество итераций значительно уменьшается.
Листинг подпрограммы
procedure Poisk(n:integer; zb:Artype; delta:real;
Var z1:Artype; Var w:real;
Var l:integer; F:Funop);
Var
z:Artype; i:integer; y:real;
begin
w:=f(zb);
z:=zb; z1:=zb; l:=0;
for i:=1 to n do
begin
z[i]:=zb[i]+delta; y:=f(z);
if y<w then
begin
z1[i]:=z[i]; l:=l+1; w:=y
end
else begin
z[i]:=zb[i]-delta; y:=f(z);
if y<w then
begin
z1[i]:=z[i]; l:=l+1; w:=y
end
end;
end;
w:=f(z1);
end;
procedure MyClass.OptPoisk(n,m:integer;
delta,eps:real; xo:Artype; Var xb:Artype;
Var Yopt:real; Var ip:integer; F:Funop);
Label 6,7,10;
Var x1,x2,x3:Artype;
d,wo,y1,y2,y3:real; i,l:integer;
a,b:string;
Procedure Outt(x:Artype; y:real);
Var i:integer;
begin
for i:=1 to n do
begin
str(x[i]:8:3,a); str(y:9:3,b);
form1.ListBox2.Items.Add('X'+inttostr(i)+'='+a);
with formgraph do
begin
imGraph.Canvas.Pen.Color:=clRed;
imgraph.Canvas.LineTo(round(mx* x[1]+ Sx),
round(-my* x[2]+ Sy));
imGraph1_3.Canvas.Pen.Color:=clBlue;
imgraph1_3.Canvas.LineTo(round(mx* x[1]+ Sx),
round(-my* x[3]+ Sy));
imGraph2_3.Canvas.Pen.Color:=clBlack;
imgraph2_3.Canvas.LineTo(round(mx* x[2]+ Sx),
round(-my* x[3]+ Sy));
end;
end;
str(y:9:1,b);
form1.ListBox2.Items.Add('--------------------- F='+b+'-----------');
end;
Begin
f:=model;
d:=delta;
wo:=f(xo);
ip:=0;
with formGraph do
begin
imGraph.Canvas.Pen.Width:=2;
imGraph1_3.Canvas.Pen.Width:=2;
imGraph2_3.Canvas.Pen.Width:=2;
for i:=1 to n do
begin //Перо в начальную точку
imGraph.Canvas.TextOut(round(mx* xo[1]+ Sx),
round(-my* xo[2]+ Sy),inttostr(ip));
imGraph.Canvas.MoveTo(round(mx* xo[1]+ Sx),
round(-my* xo[2]+ Sy));
imGraph1_3.Canvas.TextOut(round(mx* xo[1]+ Sx),
round(-my* xo[3]+ Sy),inttostr(ip));
imGraph1_3.Canvas.MoveTo(round(mx* xo[1]+ Sx),
round(-my* xo[3]+ Sy));
imGraph2_3.Canvas.TextOut(round(mx* xo[2]+ Sx),
round(-my* xo[3]+ Sy),inttostr(ip));
imGraph2_3.Canvas.MoveTo(round(mx* xo[2]+ Sx),
round(-my* xo[3]+ Sy));
end;
end;
Outt(xo,wo);
xb:=xo;
10: Poisk(n,xb,d,x1,y1,l,F);
ip:=ip+1;
if l=0 then goto 6;
7: for i:=1 to n do
x2[i]:=2*x1[i]-xb[i];
y2:=f(x2);
Poisk(n,x2,d,x3,y3,l,F);
ip:=ip+1;
if ip>m then
begin
ShowMessage('Число итераций > '+inttostr(m)+#13+'Минимум не найден!!!');
xb:=x3;
Yopt:=f(xb);
Exit
end;
if y3<y1 then
begin
xb:=x1; wo:=f(xb);
Outt(xb,wo);
x1:=x3; y1:=y3;
goto 7
end
else
begin
xb:=x1; wo:=f(xb);
Outt(xb,wo);
goto 10
end;
6: if d>=eps then
begin
d:=d/5;
goto 10
end
else Yopt:=f(xb);
form1.ListBox2.Items.Add('Число итераций - '+InttoStr(ip));
for i:=1 to n do
begin
str(xb[i]:8:3,a);
form1.ListBox2.Items.Add('X'+inttostr(i)+'опт'+'='+a);
end;
form1.listbox2.Items.Add('Минимум - '+FloatToStr(opt1_5.Yopt));
end;
function model(x:Artype): real;
begin
model:={25*sqr(x[1]+3)+4*sqr(x[3]-4)+10*sqr(x[1]-x[2])+10;}
{3*sqr(x[1]-4)+50*sqr(x[2]-3)+16*sqr(x[1]-x[3])+12;}
16*sqr(x[1]+2)+4*sqr(x[2]-3)+5*sqr(x[3]-x[2])-8;
end;
Задание 6
МЕТОДЫСЛУЧАЙНОГО ПОИСКА РЕШЕНИЯ МНОГОМЕРНЫХ ЗАДАЧ ОПТИМИЗАЦИИ
Цель задания: приобрести практические навыки поиска на ЭВМ условного экстремума функций многих переменных методом случайного поиска с пересчетом.
Индивидуальное задание.
Найдите минимум функции методом случайного поиска, выбрав начальной точкой Хо(0, 0, 0) при изменении аргументов Xi в пределах [ai, bi]. Предусмотрите отрисовку поиска минимума в координатах x1Ox2, x1Ox3, x2Ox3.
Проведите сравнительный анализ по числу вычислений функции задавая параметр М=10, 15, 20 при шаге Н=20 и, задавая Н=0,5; 1; 2 при М=15
Рисунок 12 – блок-схема метода случайного поиска с перечётом.
Рисунок 13 решение задачи на ЭВМ и траектория поиска оптимальных значений функции
Результаты работы программы изображены на рисунке 13.
Вывод: в основе метода случайного поиска лежит внесение элементов случая в процедуру формирования пробных точек, которые используются для определения направления поиска. Данный метод эффективен для функций с большим количеством переменных, так как ограничивается количество вычислений функции за счёт нахождения антиградиентного направления с помощью пробных точек.
Листинг подпрограммы метода
unit Opt1_6;
interface
uses
Dialogs, SysUtils,Graphics;
Const n=3;
Type Artype=array[1..n] of real;
Funop=function(xi:Artype):real;
type MyClass=class
public
procedure slpoisk(n,m,mf:integer;
h,hmin:real; xmin,xmax:Artype;
Var xo:Artype; Var Yopt:real; F:Funop);
end;
var opt6:MyClass;
var
F:FUNOP;
i,m,mf,im:integer;
h,hmin:real;
xmin,xmax:Artype;
xo,x:Artype;
Yopt:real;
function model(x:Artype): real;
implementation
uses main,unitGraph;
function model(x:Artype): real;
begin
model:={25*sqr(x[1]+3)+4*sqr(x[3]-4)+10*sqr(x[1]-x[2])+10;}
{10*sqr(x[1]-x[2])+4*sqr(x[1]-2)+25*sqr(x[3]+x[2])+8;}
16*sqr(x[1]+2)+4*sqr(x[2]-3)+5*sqr(x[3]-x[2])-8;
end;
procedure Myclass.slpoisk(n,m,mf:integer;
h,hmin:real; xmin,xmax:Artype;
Var xo:Artype; Var Yopt:real; F:Funop);
Label 9,10;
Var x,d,s:Artype; b,hr,y0,y,qsi:real; i,l,k:integer;
Procedure Outt(x:Artype; y:real; kod:integer);
Var i:integer;a,b,c:string;
begin
for i:=1 to n do
begin
str(x[i]:8:3,a); str(y:9:3,b);
form1.ListBox3.Items.Add('X'+inttostr(i)+
'='+a);
if (kod=1) then
with formgraph do
begin
imGraph.Canvas.Pen.Color:=clRed;
imgraph.Canvas.LineTo(round(mx* x[1]+ Sx),
round(-my* x[2]+ Sy));
imGraph1_3.Canvas.Pen.Color:=clBlue;
imgraph1_3.Canvas.LineTo(round(mx* x[1]+ Sx),
round(-my* x[3]+ Sy));
imGraph2_3.Canvas.Pen.Color:=clBlack;
imgraph2_3.Canvas.LineTo(round(mx* x[2]+ Sx),
round(-my* x[3]+ Sy));
end;
end;
case Kod of
0: c:='Начальная точка';
1: c:='Функция убывает';
2: c:='Пробнная точка';
end;
form1.ListBox3.Items.Add('----------- '+c+' ------'+' F='+b);
end;
// main
begin
f:=model;
b:=-1e20;
for i:=1 to n do
begin
d[i]:=xmax[i]-xmin[i];
if d[i]>b then
b:=d[i];
end;
for i:=1 to n do
s[i]:=d[i]/b;
hr:=h; y0:=f(xo); im:=1;
with formGraph do
begin
imGraph.Canvas.Pen.Width:=2;
imGraph1_3.Canvas.Pen.Width:=2;
imGraph2_3.Canvas.Pen.Width:=2;
for i:=1 to n do
begin //Перо в начальную точку
imGraph.Canvas.TextOut(round(mx* xo[1]+ Sx),
round(-my* xo[2]+ Sy),inttostr(im));
imGraph.Canvas.MoveTo(round(mx* xo[1]+ Sx),
round(-my* xo[2]+ Sy));
imGraph1_3.Canvas.TextOut(round(mx* xo[1]+ Sx),
round(-my* xo[3]+ Sy),inttostr(im));
imGraph1_3.Canvas.MoveTo(round(mx* xo[1]+ Sx),
round(-my* xo[3]+ Sy));
imGraph2_3.Canvas.TextOut(round(mx* xo[2]+ Sx),
round(-my* xo[3]+ Sy),inttostr(im));
imGraph2_3.Canvas.MoveTo(round(mx* xo[2]+ Sx),
round(-my* xo[3]+ Sy));
end;
end;
Outt(xo,y0,0);
randomize;
9: k:=0;
10: l:=0;
for i:=1 to n do
begin
qsi:=2*random-1;
x[i]:=xo[i]+hr*s[i]*qsi;
if x[i]>xmax[i] then
begin
x[i]:=xmax[i]; l:=l+1
end
else if x[i]<xmin[i] then
begin
x[i]:=xmin[i]; l:=l+1
end
end;
if l<n then
begin
y:=f(x);
outt(x,y,2);
if y<y0 then outt(x,y,1);
im:=im+1;
if im>mf then
begin
showMessage('Число вычислений функции > '+IntTostr(mf)+#13+'Минимум не нейден!!!');
Yopt:=y0;
Exit
end;
if y<y0 then
begin
y0:=y;xo:=x;
goto 9;
end
end;
k:=k+1;
if k<m then goto 10
else
begin
hr:=hr/2;
if hr<hmin then
begin
Yopt:=y0;
for i:=1to n do
form1.ListBox3.Items.Add('X'+inttostr(i)+'опт'+'='+floattostrf(x[i],ffGeneral,5,2));
form1.ListBox3.Items.Add('Yопт = '+floattostrf(Yopt,ffGeneral,5,2));
form1.ListBox3.Items.Add('Число вычислений функции = '+InttoStr(im));
Exit end
else goto 9;
end;
end;
end.