Рисунок 7 Решение задачи на ЭВМ и траектория поиска оптимальных значений (при Хо(-2,-4))
unitOpt1_4;
interface
uses
Messages, SysUtils, Graphics, Forms, Dialogs;
const n=2;
type Artype =array[1..n] of real;
Funop=function(xi:Artype):real;
ProcMin=Procedure(a,b,e:real; var xm,ym:real);
type
TForm2 = class(TForm)
private
public
procedure Optimiz(k: integer);
end;
var
Form2: TForm2;
Nmax,prn,NN:integer;
e,Fopt:real;
X0,G:artype;
f1:funop;
Pmin:ProcMin;
kAntGrad:real;
function model1(x: Artype): real;
implementation
uses Main,UnitGraph;
// Подпрограммавычислениязаданнойфункции
function model(x:Artype):real;
begin
model:= exp(x[1])+sqr(x[2])-2*x[1];
end;
{main program}
procedure Grad(n: integer; e: real; x: artype; var g: Artype;
F: Funop);
Var i:integer; fp,fo:real;
begin
for i:=1 to n do
begin
x[i]:=x[i]+e;
fp:=F(x);
x[i]:=x[i]-2*e;
fo:=F(x);
x[i]:=x[i]+e;
g[i]:=(fp-fo)/2/e;
end;
end;
procedure Opgrad(n: integer; e: real; var xk: Artype; Nmax: integer;
prn: byte; var Fopt: real; var nn: integer; F: Funop);
Label 1;
Var dk:Artype;//Градиент
od{нормавектор-градиента},
lambda{шаг},s,sf:real;
i:integer;
Function FF(x:real):real;
Var i:integer;
begin
for i:=1 to n do
xk[i]:=xk[i]+abs(x)*dk[i]/od;
FF:=F(xk);
for i:=1 to n do
xk[i]:=xk[i]-abs(x)*dk[i]/od;
end;
Procedure Min(a0,b0,e:real; Var xm,ym:real);// Метод Дихотомии
Label 1,2;
Var x1,x2,y1,y2,delta,a,b:real;
k,n:integer;
begin
a:=a0; b:=b0;
delta:=e/2;
1: n:=2*k;
x1:=(a+b-delta)/2;
x2:=(a+b+delta)/2;
y1:=ff(x1); y2:=ff(x2);
if y1<=y2 then b:=x2
else a:=x1;
if (b-a)<e then
begin
xm:=(a+b)/2;
ym:=ff(xm);
end
else
begin
k:=k+1;
goto 1
end;
end;
{main prcvedure}
BEGIN
nn:=0; lambda:=0;
if prn=0 then
begin
for i:=1 to n do
form1.ListBox1.Items.Add('x'+inttostr(i)+'='+Floattostr(xk[i])+' ');
form1.ListBox1.Items.Add(#13 + 'Целевая функция = '+ Floattostr(F(xk))+#13);
end;
repeat
Grad(n,e/2,xk,dk,F);
for i:=1 to n do
dk[i]:=-dk[i]; sf:=F(xk);
if prn=1 then
begin
form1.ListBox1.Items.Add('Итерация №'+inttostr(nn)+ #13 +' Шаг = '+Floattostrf(lambda,ffGeneral,8,5) );
form1.ListBox1.Items.Add('Текущая точка ');
for i:=1 to n do
begin
form1.ListBox1.Items.Add('X'+inttostr(i)+'='+floattostrf(xk[i],ffGeneral,8,5));
formGraph.imGraph.Canvas.LineTo(round( mx* xk[1]+ Sx),round( -my* xk[2]+ Sy));
end;
form1.ListBox1.Items.Add(#13+'Текущий антиградиент');
for i:=1 to n do
form1.ListBox1.Items.Add('g'+inttostr(i)+'='+Floattostrf(dk[i],ffGeneral,8,5)+' ');
form1.ListBox1.Items.Add(' Целевая функция F = '+Floattostrf(sf,ffGeneral,8,5));
form1.ListBox1.Items.Add('-------------------------------------------');
end;
od:=0;
for i:=1 to n do
od:=od+sqr((dk[i]));
od:=sqrt(od); if od<e then goto 1;
nn:=nn+1;
if nn>Nmax then
begin
nn:=nn-1;
showmessage('Минимум не найден !!!'+ #13+' Необходимое числоитераций больше выделенного ресурса'+Inttostr(Nmax));
Fopt:=F(xk);
Exit
end;
Min(0,10,e,lambda,s);
for i:=1 to n do
xk[i]:=xk[i]+lambda*dk[i]/od;
Until(lambda<e);
1: Fopt:=F(xk);
with form1.ListBox1.Items do
begin
Add(' Оптимальные значения за '+inttostr(nn)+' итерации');
for i:=1 to n do
Add('X'+inttostr(i)+'*'+'='+floattostrf(xk[i],ffGeneral,8,5));
Add(' Целевая функция F(X*) = '+Floattostrf(fopt,ffGeneral,8,5));
end;
end;
function model1(x: Artype): real;
begin
end;
procedure TForm2.Optimiz(k: integer);
begin
try // вводначальныхусловий
with form1 do
begin
X0[1]:=strtofloat(form1.Edit12.Text);
X0[2]:=strtofloat(form1.Edit13.Text);
end
except
showMessage('Неправильно введены начальные условия');
end;
with FormGraph do //координатная плоскость
begin
{Установка максимума и минимума функции}
Xb:=-abs(X0[1])-5; Xe:=abs(X0[1])+5; Ymin:=-abs(X0[2])-5;Ymax:=abs(X0[2])+5;
GrafOrt;
end;
Nmax:=500; e:=0.00001;prn:=1;
formGraph.imGraph.Canvas.Pen.Color:=clRed;
formgraph.imGraph.Canvas.Pen.Width:=2;
formgraph. imGraph.Canvas.TextOut(round( mx* x0[1]+ Sx),
round( -my* x0[2]+ Sy),'0');
formGraph.imGraph.Canvas.MoveTo(round( mx* x0[1]+ Sx),round( -my* x0[2]+ Sy));
F1:=Model;
Grad(n,0.1,X0,g,f1);
Opgrad(n,e,X0,Nmax,prn,fopt,NN,f1);
formgraph.imGraph.Canvas.Pen.Width:=1;
end;
end.
Задание 5
МЕТОДЫ НУЛЕВОГО ПОРЯДКА РЕШЕНИЯ МНОГОМЕРНЫХ ЗАДАЧ ОПТИМИЗАЦИИ
Цель задания: приобрести практические навыки разработки алгоритмов и программ оптимизации многомерных функций методами ненулевого порядка, в частности методом прямого поиска.
Рисунок 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.
Вывод: в основе метода случайного поиска лежит внесение элементов случая в процедуру формирования пробных точек, которые используются для определения направления поиска. Данный метод эффективен для функций с большим количеством переменных, так как ограничивается количество вычислений функции за счёт нахождения антиградиентного направления с помощью пробных точек.
Листинг подпрограммы метода
unitOpt1_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;