Листинг подпрограммы метода.

unit Opt1_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 – Блок-схема метода прямого поиска