Листинг программы
unit untMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Series, ArrowCha, Math, TeEngine, TeeProcs, Chart,
Grids;
type
TFunc = function (x:extended):extended;
TVekt = array of extended;
TCelf = function (x:TVekt):extended;
TVals = record x, y: extended; end;
TForm1 = class(TForm)
pnlDraw: TPanel;
crtGraph: TChart;
srsAxisY: TLineSeries;
srsAxisX: TLineSeries;
srsGraph: TArrowSeries;
graf1: TLineSeries;
graf2: TLineSeries;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
edX1: TEdit;
edX2: TEdit;
edNmax: TEdit;
edE: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
edX1min: TEdit;
edX2min: TEdit;
edFmin: TEdit;
edN: TEdit;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
btnWork: TButton;
GroupBox3: TGroupBox;
strF: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure btnWorkClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
//Нахождение градиента функции
procedure gradmin(f:TCelf; m:integer; e:extended; var xo:TVekt;
var yopt:extended; var ip:integer);
//Добавление координат для отрисовки
procedure addkoord(f:TCelf; xo:TVekt);
//Отрисовка графика по векторам
procedure drawvekt(series:TArrowSeries; x, y:TVekt);
//Отрисовка графика по функции
procedure drawfunc(series:TLineSeries; f:TFunc; a, b:extended);
end;
var
Form1: TForm1;
xk: TVekt;
e, d, fopt: extended;
Nmax, ip:integer;
gx, gy, gz, gr: TVekt;
dta: array [1..100] of extended;
p: integer;
implementation
function f(x:TVekt):extended;
begin
f:=sqr(exp(-x[0])-exp(x[1])+1)+ sqr(x[1]*x[0]+1);
end;
function gr1(x:extended):extended;
begin
result:=1/(exp(x)-1);
end;
function gr2(x:extended):extended;
begin
result:=-(1/x);
end;
//Нахождение градиента функции
function gradient(f:TCelf; e:extended; x:TVekt): TVekt;
var
n, i: integer;
fp, fo: extended;
g: TVekt;
begin
n:=length(x);
setlength(g,n);
for i:= 0 to n-1 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;
gradient:=g;
end;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
with strF do begin
cells[0,0]:='№ итерации';
cells[1,0]:=' X1';
cells[2,0]:=' X2';
cells[3,0]:='DELTA';
end;
setlength(xk, 2);
try
xk[0]:=strtofloat(edX1.Text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
try
xk[1]:=strtofloat(edX2.text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
try
Nmax:=strtoint(edNmax.Text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
try
e:=strtofloat(edE.text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
end;
procedure TForm1.btnWorkClick(Sender: TObject);
var a:extended; i:integer;
begin
Form1.oncreate(Form1);
a:=xk[0];
gradmin(f, Nmax, e, xk, fopt, ip);
drawfunc(graf1,gr1,xk[0]-(a-xk[0])/5,a);
drawfunc(graf2,gr2,xk[0]-(a-xk[0])/5,a);
if ip=0 then showmessage('Превышено Nmax');
edX1min.text:=floattostr(xk[0]);
edX2min.text:=floattostr(xk[1]);
edFmin.text:=floattostr(fopt);
edN.text:=floattostr(ip);
strF.RowCount:=ip+1;
for i:=1 to ip do
with strF do begin
cells[0,i]:=inttostr(i);
cells[1,i]:=floattostr(gx[i]);
cells[2,i]:=floattostr(gy[i]);
cells[3,i]:=floattostr(round(dta[i]*1000000)/1000000);
end;
drawvekt(srsGraph, gx, gy);
end;
procedure TForm1.gradmin(f:TCelf; m:integer; e:extended; var xo:TVekt;var yopt:extended; var ip:integer);
var
dk: TVekt;
od, lambda, s: extended;
i, n: integer;
function ff(x:extended): extended;
var i: integer;
begin
for i:=0 to n-1 do xo[i]:=xo[i]+abs(x)*dk[i]/od;
ff:=f(xo);
for i:=0 to n-1 do xo[i]:=xo[i]-abs(x)*dk[i]/od;
end;
procedure min(a, b, e:extended; var xm,ym:extended);
var x, y, xo, xk, h:extended;
begin
xo:=a;
xk:=b;
h:=1;
repeat
ym:=1e30;
x:=xo;
while x<=xk do begin
y:=ff(x);
if y<= ym then begin
ym:=y;
xm:=x;
x:=x+h;
end
else break;
end;
if h<e then exit;
xo:=xm-h;
xk:=xm+h;
if xo<a then xo:=a;
if xk>b then xk:=b;
h:=h/5;
until false;
end;
begin
setlength(gx, 0);
setlength(gy, 0);
setlength(gz, 0);
setlength(gr, 0);
addkoord(f, xo);
n:=length(xo);
ip:=0;
lambda:=0;
repeat
dk:=gradient(f, e/2, xo);
for i:=0 to n-1 do dk[i]:=-dk[i];
od:=0;
for i:=0 to n-1 do od:=od+sqr(dk[i]);
od:=sqrt(od);
if od<e then break;
ip:=ip+1;
addkoord(f, xo);
if ip>m then begin
ip:=0;
yopt:=f(xo);
exit;
end;
min(0, 10, e, lambda, s);
dta[ip]:=lambda;
for i:=0 to n-1 do xo[i]:=xo[i]+lambda*dk[i]/od;
until lambda<e;
addkoord(f, xo);
yopt:=f(xo);
end;
procedure TForm1.addkoord(f:TCelf; xo:Tvekt);
var n:integer;
begin
n:=length(gx);
setlength(gx, n+1);
setlength(gy, n+1);
setlength(gz, n+1);
setlength(gr, n+1);
gx[n]:=xo[0];
gy[n]:=xo[1];
if length(xo)>2 then gz[n]:=xo[2] else gz[n]:=0;
gr[n]:=f(xo);
end;
procedure TForm1.drawvekt(series:TArrowSeries; x, y:TVekt);var i:integer;
begin
series.clear;
for i:=0 to length(x)-2 do
series.addarrow(x[i], y[i], x[i+1], y[i+1], '', series.seriescolor);
if p>series.count-1 then p:=series.count-1;
end;
procedure TForm1.drawfunc(series:TLineSeries; f:TFunc; a, b:extended);
var d:extended;
begin
series.clear;
d:=abs(a-b)/100;
while a<b+d do begin
series.addxy(a, f(a), '', series.seriescolor);
a:=a+d;
end;
if p>series.count-1 then p:=series.count-1;
end;
end.
Листинг программы
unit untMain;
Interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Series, ArrowCha, Math, TeEngine, TeeProcs, Chart,
Grids;
type
TFunc = function (x:extended):extended;
TVekt = array of extended;
TCelf = function (x:TVekt):extended;
TVals = record x, y: extended; end;
TForm1 = class(TForm)
pnlDraw: TPanel;
crtGraph: TChart;
srsAxisY: TLineSeries;
srsAxisX: TLineSeries;
srsGraph: TArrowSeries;
graf1: TLineSeries;
graf2: TLineSeries;
GroupBox1: TGroupBox;
GroupBox2: TGroupBox;
edX1: TEdit;
edX2: TEdit;
edNmax: TEdit;
edE: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
edX1min: TEdit;
edX2min: TEdit;
edFmin: TEdit;
edN: TEdit;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
btnWork: TButton;
GroupBox3: TGroupBox;
strF: TStringGrid;
procedure FormCreate(Sender: TObject);
procedure btnWorkClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
//Нахождение градиента функции
procedure gradmin(f:TCelf; m:integer; e:extended; var xo:TVekt;
Var yopt:extended; var ip:integer);
//Добавление координат для отрисовки
procedure addkoord(f:TCelf; xo:TVekt);
//Отрисовка графика по векторам
procedure drawvekt(series:TArrowSeries; x, y:TVekt);
//Отрисовка графика по функции
procedure drawfunc(series:TLineSeries; f:TFunc; a, b:extended);
end;
var
Form1: TForm1;
Xk: tVekt;
e, d, fopt: extended;
Nmax, ip:integer;
gx, gy, gz, gr: TVekt;
dta: array [1..100] of extended;
p: integer;
Implementation
function f(x:TVekt):extended;
begin
f:=sqr(exp(x[1])-sqr(x[1])+1)+ sqr(x[1]*sin(x[1])/cos(x[1]));
end;
function gr1(x:extended):extended;
begin
result:=1/(exp(x)-1);
end;
function gr2(x:extended):extended;
begin
result:=-(1/x);
end;
//Нахождение градиента функции
function gradient(f:TCelf; e:extended; x:TVekt): TVekt;
var
n, i: integer;
fp, fo: extended;
g: TVekt;
begin
n:=length(x);
setlength(g,n);
for i:= 0 to n-1 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;
gradient:=g;
end;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
with strF do begin
cells[0,0]:='№ итерации';
cells[1,0]:=' X1';
cells[2,0]:=' X2';
cells[3,0]:='DELTA';
end;
setlength(xk, 2);
try
xk[0]:=strtofloat(edX1.Text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
try
xk[1]:=strtofloat(edX2.text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
try
Nmax:=strtoint(edNmax.Text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
try
e:=strtofloat(edE.text);
except
ShowMessage('Ошибка ввода данных!');
Exit;
end;
end;
procedure TForm1.btnWorkClick(Sender: TObject);
var a:extended; i:integer;
begin
Form1.oncreate(Form1);
a:=xk[0];
gradmin(f, Nmax, e, xk, fopt, ip);
drawfunc(graf1,gr1,xk[0]-(a-xk[0])/5,a);
drawfunc(graf2,gr2,xk[0]-(a-xk[0])/5,a);
if ip=0 then showmessage('Превышено Nmax');
edX1min.text:=floattostr(xk[0]);
edX2min.text:=floattostr(xk[1]);
edFmin.text:=floattostr(fopt);
edN.text:=floattostr(ip);
strF.RowCount:=ip+1;
for i:=1 to ip do
with strF do begin
cells[0,i]:=inttostr(i);
cells[1,i]:=floattostr(gx[i]);
cells[2,i]:=floattostr(gy[i]);
cells[3,i]:=floattostr(round(dta[i]*1000000)/1000000);
end;
drawvekt(srsGraph, gx, gy);
end;
procedure TForm1.gradmin(f:TCelf; m:integer; e:extended; var xo:TVekt;var yopt:extended; var ip:integer);
var
dk: TVekt;
od, lambda, s: extended;
i, n: integer;
function ff(x:extended): extended;
var i: integer;
begin
for i:=0 to n-1 do xo[i]:=xo[i]+abs(x)*dk[i]/od;
ff:=f(xo);
for i:=0 to n-1 do xo[i]:=xo[i]-abs(x)*dk[i]/od;
end;
procedure min(a, b, e:extended; var xm,ym:extended);
var x, y, xo, xk, h:extended;
begin
xo:=a;
xk:=b;
h:=1;
repeat
ym:=1e30;
x:=xo;
while x<=xk do begin
y:=ff(x);
if y<= ym then begin
ym:=y;
xm:=x;
x:=x+h;
end
else break;
end;
if h<e then exit;
xo:=xm-h;
xk:=xm+h;
if xo<a then xo:=a;
if xk>b then xk:=b;
h:=h/5;
until false;
end;
begin
setlength(gx, 0);
setlength(gy, 0);
setlength(gz, 0);
setlength(gr, 0);
addkoord(f, xo);
n:=length(xo);
ip:=0;
lambda:=0;
repeat
dk:=gradient(f, e/2, xo);
for i:=0 to n-1 do dk[i]:=-dk[i];
od:=0;
for i:=0 to n-1 do od:=od+sqr(dk[i]);
od:=sqrt(od);
if od<e then break;
ip:=ip+1;
addkoord(f, xo);
if ip>m then begin
ip:=0;
yopt:=f(xo);
exit;
end;
min(0, 10, e, lambda, s);
dta[ip]:=lambda;
for i:=0 to n-1 do xo[i]:=xo[i]+lambda*dk[i]/od;
until lambda<e;
addkoord(f, xo);
yopt:=f(xo);
end;
procedure TForm1.addkoord(f:TCelf; xo:Tvekt);
var n:integer;
begin
n:=length(gx);
setlength(gx, n+1);
setlength(gy, n+1);
setlength(gz, n+1);
setlength(gr, n+1);
gx[n]:=xo[0];
gy[n]:=xo[1];
if length(xo)>2 then gz[n]:=xo[2] else gz[n]:=0;
gr[n]:=f(xo);
end;
procedure TForm1.drawvekt(series:TArrowSeries; x, y:TVekt);var i:integer;
begin
series.clear;
for i:=0 to length(x)-2 do
series.addarrow(x[i], y[i], x[i+1], y[i+1], '', series.seriescolor);
if p>series.count-1 then p:=series.count-1;
end;
procedure TForm1.drawfunc(series:TLineSeries; f:TFunc; a, b:extended);
var d:extended;
begin
series.clear;
d:=abs(a-b)/100;
while a<b+d do begin
series.addxy(a, f(a), '', series.seriescolor);
a:=a+d;
end;
if p>series.count-1 then p:=series.count-1;
end;
end.