Синтез системы управления спуском космического аппарата на поверхность Марса методом интеллектуальной эволюции

O1s1,

O2s1,

Pnum1,

Rnum1,

Dnum1:TArrInt;

q1:TArrReal;

Psi1:TArrArrInt;

kChoose:integer;// number of choose chromosome

xm:TArrArrReal;

tm:TArrReal;

um:TArrArrReal;

f0,f1:real;

Procedure UpProgressBar;

Function TermStop:boolean;

//*********************************************************

IMPLEMENTATION

//*********************************************************

Uses Calc3, Calc5, Calc4, Unit6, Unit7, Unit8, Unit9, Unit10, TGAModelUnit,

Unit3, Unit2, Unit14;

{$R *.dfm}

//*********************************************************

Procedure TForm1.Binaryoperations1Click(Sender: TObject);

Begin

Form5:=TForm5.create(self);

Form5.ShowModal;

End;

Procedure TForm1.Clear1Click(Sender: TObject);

Begin

Memo1.Clear;

End;

//*********************************************************

Procedure TForm1.FormCreate(Sender: TObject);

var

i:integer;

j: Integer;

Begin

randomize;

ProgressBar1.top:=212;

ProgressBar1.left:=0;

ProgressBar1.width:=ClientWidth;

Memo1.Top:=0;

Memo1.Left:=0;

Memo1.Height:=progressbar1.top;

Memo1.Width:=ClientWidth;

Memo1.ReadOnly:=true;

Setlength(O1s1,kW1);

Setlength(O2s1,kV1);

Setlength(Pnum1,kP1);

Setlength(Rnum1,kR1);

Setlength(Dnum1,Mout1);

Setlength(x01,n1);

Setlength(umin1,m1);

Setlength(umax1,m1);

Setlength(q1,p1);

Setlength(xm,ll1);

Setlength(um,m1);

Setlength(qymax1,ny1);

Setlength(qymin1,ny1);

Setlength(stepsqy1,ny1);

for i:=0 to kW1-1 do

O1s1[i]:=O1sc[i];

for i:=0 to kV1-1 do

O2s1[i]:=O2sc[i];

for i:=0 to kP1-1 do

Pnum1[i]:=Pnumc[i];

for i:=0 to kR1-1 do

Rnum1[i]:=Rnumc[i];

for i:=0 to Mout1-1 do

Dnum1[i]:=Dnumc[i];

for i:=0 to p1-1 do

q1[i]:=qc[i];

for i:=0 to n1-1 do

x01[i]:=x0c[i];

for i:=0 to m1-1 do

umin1[i]:=uminc[i];

for i:=0 to m1-1 do

umax1[i]:=umaxc[i];

SetLength(Psi1,L1,L1);

for i:=0 to L1-1 do

for j:=0 to L1-1 do

Psi1[i,j]:=PsiBasc[i,j];

for i:= 0 to ny1-1 do

begin

qymin1[i]:=qyminc[i];

qymax1[i]:=qymaxc[i];

stepsqy1[i]:=stepsqyc[i];

end;

End;

//*********************************************************

Procedure TForm1.GA1Click(Sender: TObject);

Begin

Form6:=TForm6.create(self);

Form6.ShowModal;

Form8:=TForm8.Create(self);

Form8.ShowModal;

if Application.MessageBox('If the object for GA with NOP will be create then '

+'you cannot to change some paprameters. To create?',

'Creation of object',

MB_OKCANCEL+MB_ICONWARNING)=ID_OK then

begin

EA:=TUser.Create(hh1, pp1, rr1, nfu1, lchr1, p1, c1, d1, epo1,

kel1, alfa1, pmut1, L1, Mout1, kp1,

kr1, kw1, kv1,n1,m1,ll1,ny1);

GA1.Enabled:=false;

Geneticalgorithm1.Enabled:=true;

ParametersofGA1.Enabled:=true;

EA.EndGeneration:=UpProgressBar;

end

else

exit;

End;

//*********************************************************

Procedure TForm1.GAforNOPParameters1Click(Sender: TObject);

Begin

ProgressBar1.Max:=EA.PP;

EA.GenAlgorithm;

Paretoset1.Enabled:=true;

End;

//*********************************************************

Procedure TForm1.GAforParameters1Click(Sender: TObject);

Begin

ProgressBar1.Max:=EA.PP;

EA.GenAlgorithm1;

Paretoset1.Enabled:=true;

End;

//*********************************************************

Procedure TForm1.Geneticalgorithm1Click(Sender: TObject);

Begin

Form7:=TForm7.create(self);

Form7.ShowModal;

Optimization1.Enabled:=true;

Expression1.Enabled:=true;

End;

//*********************************************************

Procedure TForm1.Latex1Click(Sender: TObject);

var

i:integer;

Begin

EA.NOP.PsitoTexStr;

for i:=0 to L1-1 do

memo1.Lines.Add(EA.NOP.zs[i]);

End;

//*********************************************************

Procedure TForm1.Model1Click(Sender: TObject);

const

epsterm=1e-2;

var

k,i,j:integer;

tp:real;

Begin

Form2:=TForm2.Create(self);

Form2.ShowModal;

EA.Initial;

tp:=0;

k:=0;

EA.NOP.SetCs(q1);

f0:=0;

repeat

if abs(EA.t-tp)<EA.dt/2 then

begin

k:=k+1;

for i:=0 to ll1-1 do

Setlength(xm[i],k);

for i:=0 to m1-1 do

Setlength(um[i],k);

Setlength(tm,k);

EA.Viewer;

EA.NOP.Vs[0]:=EA.y[EA.n];//x[0];

EA.NOP.Vs[1]:=EA.y[EA.n+1];//x[1];

EA.NOP.Vs[2]:=EA.y[EA.n+2];//x[2];

EA.NOP.Vs[3]:=EA.y[EA.n+3];//x[3];

EA.NOP.RPControl;

for i:=0 to m1-1 do

EA.u[i]:=EA.NOP.z[EA.NOP.Dnum[i]];

EA.OgrUpr;

for i:=0 to ll1-1 do

xm[i,k-1]:=EA.y[i];

for i:=0 to m1-1 do

um[i,k-1]:=EA.u[i];

tm[k-1]:=EA.t;

tp:=tp+dtp;

end;

EA.Viewer;

EA.NOP.Vs[0]:=EA.y[EA.n];//x[0];

EA.NOP.Vs[1]:=EA.y[EA.n+1];//x[1];

EA.NOP.Vs[2]:=EA.y[EA.n+2];//x[2];

EA.NOP.Vs[3]:=EA.y[EA.n+3];//[3];

if f0<EA.y[EA.lv-1] then f0:=EA.y[EA.lv-1];

EA.Euler2;

until (EA.y[EA.n]<=xfc[0])or(EA.t>=EA.tf);

if EA.y[EA.n]>xfc[0] then

f1:=abs(EA.y[EA.n]-xfc[0])+abs(EA.y[EA.n+1]-xfc[1])

else f1:=abs(EA.y[EA.n+1]-xfc[1]);

Form11:=TForm11.create(self);

Form11.ShowModal;

End;

Procedure TForm1.ParametersofGA1Click(Sender: TObject);

Begin

Form9:=TForm9.create(self);

Form9.ShowModal;

End;

Procedure TForm1.Parametersofmodel1Click(Sender: TObject);

Begin

Form3:=TForm3.Create(self);

Form3.ShowModal;

End;

//*********************************************************

Procedure TForm1.Paretoset1Click(Sender: TObject);

var

i:integer;

Begin

Form10:=TForm10.create(self);

Form10.ShowModal;

label1.Caption:=inttostr(kchoose);

EA.ReadChromosome(kchoose,q1,Psi1);

End;

//*********************************************************

Procedure TForm1.Pascal1Click(Sender: TObject);

var

i:integer;

Begin

EA.NOP.PsitoPasStr;

for i:=0 to L1-1 do

memo1.Lines.Add(EA.NOP.zs[i]);

End;

//*********************************************************

Procedure TForm1.Savetofile1Click(Sender: TObject);

Begin

if savedialog1.Execute then

Memo1.Lines.SaveToFile(savedialog1.FileName);

End;

//*********************************************************

Procedure TForm1.Unaryoperations1Click(Sender: TObject);

Begin

Form4:=TForm4.create(self);

Form4.ShowModal;

End;

//*********************************************************

Procedure TForm1.Undefinedparameters1Click(Sender: TObject);

var

i:integer;

Begin

Form14:=TForm14.Create(Self);

Form14.ShowModal;

EA.Setqymin(qymin1);

EA.Setqymax(qymax1);

EA.Setstepsqy(stepsqy1);

for i:=0 to ny1-1 do

EA.ix[i]:=trunc((qymax1[i]-qymin1[i])/stepsqy1[i]);

EA.Setixmax(EA.ix);

End;

//*********************************************************

Procedure UpProgressBar;

Begin

Form1.ProgressBar1.StepIt;

Form1.Refresh;

End;

{ TGANOPUser }

//*********************************************************

Constructor TUser.Create(hh1, pp1, rr1, nfu1, lchr1, p1, c1, d1, epo1,

kel1: integer; alfa1, pmut1: real; L1, Mout1,

kp1, kr1, kw1, kv1,n1,m1,ll1,ny1: integer);

Begin

Inherited Create(hh1, pp1, rr1, nfu1, lchr1, p1, c1, d1, epo1,

kel1, alfa1, pmut1, L1, Mout1, kp1, kr1, kw1,

kv1,n1,m1,ll1,ny1);

End;

//*********************************************************

Procedure TUser.Func(var Fu: TArrReal);

var

t1,FF:real;

i:integer;

flag:boolean;

Begin

Initial;

t1:=t;

flag:=false;

FF:=0;

for i:=0 to NOP.kR-1 do

NOP.Cs[i]:=q[i];

repeat

Viewer;

NOP.Vs[0]:=y[n];//x[0];

NOP.Vs[1]:=y[n+1];//x[1];

NOP.Vs[2]:=y[n+2];//x[2];

NOP.Vs[3]:=y[n+3];//x[3];

NOP.RPControl;

if y[lv-1]>FF then

FF:=y[lv-1];

Euler2;

until (y[n]<=xfc[0])or(t>=tf);

Fu[0]:=FF;

if xfc[0]<y[n] then Fu[1]:=abs(xfc[1]-y[n+1])+abs(xfc[0]-y[n])

else Fu[1]:=abs(xfc[1]-y[n+1]);

End;

procedure TUser.Initial;

begin

x[0]:=x0[0];

x[1]:=vc*cos(qy[0]);

x[2]:=x0[2]+qy[1];

x[3]:=vc*sin(qy[0]);

t:=0;

end;

//*********************************************************

Procedure TUser.RP(t1:real;x1:TArrReal;var f1:TArrReal);

var

i:integer;

V2,QQ,NN,ro,V,GG,RR:Double;

Begin

u[0]:=NOP.z[NOP.Dnum[0]];

u[1]:=NOP.z[NOP.Dnum[1]];

OgrUpr;

RR:=sqrt(sqr(x1[0])+sqr(x1[2]));

ro:=ro_0*exp(-bet*(RR-Rz));

V2:=sqr(x1[1])+sqr(x1[3]);

V:=sqrt(V2);

QQ:=Cx*ro*V2/2/m_S;

// QQ:=Cx*(1+u[0])*ro*V2/2/m_S;

NN:=Cy*ro*V2/2/m_S;

f1[0]:=x1[1];

f1[1]:=-QQ*x1[1]/V-NN*x1[3]*cos(u[0])/V-g0*sqr(Rz/RR)*x1[0]/RR;

f1[2]:=x1[3];

f1[3]:=-QQ*x1[3]/V+NN*x1[1]*cos(u[0])/V-g0*sqr(Rz/RR)*x1[2]/RR;

for i:=0 to n-1 do

if abs(f1[i])>infinity then

f1[i]:=Ro_10(f1[i])*infinity;

End;

Procedure TUser.Viewer;

var

i:integer;

V2,QQ,NN,ro,VV,GG,RR,xper,yper,zper:double;

Begin

// Upr(t,u);

// OgrUpr(u);

RR:=sqrt(sqr(x[0])+sqr(x[2]));

ro:=ro_0*exp(-bet*(RR-Rz));

V2:=sqr(x[1])+sqr(x[3]);

VV:=sqrt(sqr(x[1])+sqr(x[3]));

QQ:=Cx*ro*V2/2/m_S;

// QQ:=Cx*(1+u[0])*ro*V2/2/m_S;

NN:=Cy*ro*V2/2/m_S;

xper:=-QQ*x[1]/VV-NN*x[3]*cos(u[0])/VV-g0*sqr(Rz/RR)*x[0]/RR;

yper:=-QQ*x[3]/VV+NN*x[1]*cos(u[0])/VV-g0*sqr(Rz/RR)*x[2]/RR;

zper:=NN*sin(u[0]);

for i:=0 to n-1 do

y[i]:=x[i];

y[n]:=RR-Rz;

y[n+1]:=Rz*arctan(x[0]/x[2]);

y[n+2]:=VV;

y[n+3]:=sqrt(sqr(xper)+sqr(yper)+sqr(zper))/g0;

End;

//*********************************************************

Function TermStop:boolean;

var

i:integer;

sum:real;

Begin

sum:=0;

for i:=0 to EA.n-1 do

sum:=sum+sqr(EA.x[i]-xfc[i]);

if sqrt(sum)<epsterm then

result:=true

else

result:=false;

End;

//*********************************************************

END.

unit Unit2;

//*********************************************************

INTERFACE

//*********************************************************

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids, UnitAdaptObjects;

type

TForm2 = class(TForm)

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

Edit1: TEdit;

Label1: TLabel;

Edit2: TEdit;

Label2: TLabel;

Edit3: TEdit;

Label3: TLabel;

Label4: TLabel;

Button1: TButton;

StringGrid3: TStringGrid;

Label5: TLabel;

Label6: TLabel;

Button2: TButton;

procedure Button2Click(Sender: TObject);

procedure StringGrid1Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form2: TForm2;

perm,u0m,HonL:TArrArrReal;

//*********************************************************

IMPLEMENTATION

//*********************************************************

Uses Unit1, Unit15;

{$R *.dfm}

Procedure TForm2.Button1Click(Sender: TObject);

var

i,j:integer;

Begin

for i:=0 to L1-1 do

for j:=0 to L1-1 do

Psi1[i,j]:=strtoint(StringGrid1.Cells[j,i]);

for i:=0 to p1-1 do

q1[i]:=strtofloat(StringGrid2.Cells[1,i]);

for i:=0 to p1-1 do

q1[i]:=strtofloat(StringGrid2.Cells[1,i]);

for i:=0 to ny1-1 do

EA.qy[i]:=strtofloat(StringGrid3.Cells[1,i]);

dt1:=strtofloat(Edit1.Text);

tf1:=strtofloat(Edit3.Text);

dtp:=strtofloat(Edit2.Text);

EA.NOP.SetPsi(Psi1);

EA.Setq(q1);

EA.Setdt(dt1);

EA.Settf(tf1);

close;

End;

Procedure TForm2.Button2Click(Sender: TObject);

var

k,i,j:integer;

tp:real;

Begin

// Form2:=TForm2.Create(self);

// Form2.ShowModal;

EA.Initial;

tp:=0;

k:=0;

EA.NOP.SetCs(q1);

f0:=0;

repeat

if abs(EA.t-tp)<EA.dt/2 then

begin

k:=k+1;

for i:=0 to ll1-1 do

Setlength(xm[i],k);

for i:=0 to m1-1 do

Setlength(um[i],k);

Setlength(tm,k);

EA.Viewer;

EA.NOP.Vs[0]:=EA.x[0];

EA.NOP.Vs[1]:=EA.x[1];

EA.NOP.Vs[2]:=EA.x[2];

EA.NOP.Vs[3]:=EA.x[3];

{

EA.NOP.Vs[0]:=xfc[0]-EA.y[4];

EA.NOP.Vs[1]:=xfc[1]-EA.y[5];

EA.NOP.Vs[2]:=(EA.x[0]*EA.x[1]+EA.x[2]*EA.x[3])/(EA.y[4]+Rz);

EA.NOP.Vs[3]:=Rz*(EA.x[0]*EA.x[3]-EA.x[2]*EA.x[1])/(EA.y[4]+Rz);

}

EA.NOP.RPControl;

EA.u[0]:=EA.NOP.z[EA.NOP.Dnum[0]];

EA.OgrUpr;

for i:=0 to ll1-1 do

xm[i,k-1]:=EA.y[i];

for i:=0 to m1-1 do

um[i,k-1]:=EA.u[i];

tm[k-1]:=EA.t;

tp:=tp+dtp;

end;

EA.Viewer;

EA.NOP.Vs[0]:=EA.x[0];

EA.NOP.Vs[1]:=EA.x[1];

EA.NOP.Vs[2]:=EA.x[2];

EA.NOP.Vs[3]:=EA.x[3];

{ EA.NOP.Vs[0]:=xfc[0]-EA.y[4];

EA.NOP.Vs[1]:=xfc[1]-EA.y[5];

EA.NOP.Vs[2]:=(EA.x[0]*EA.x[1]+EA.x[2]*EA.x[3])/(EA.y[4]+Rz);

EA.NOP.Vs[3]:=Rz*(EA.x[0]*EA.x[3]-EA.x[2]*EA.x[1])/(EA.y[4]+Rz); }

if f0<EA.y[EA.lv-1] then f0:=EA.y[EA.lv-1];

EA.Euler2;

until (EA.y[EA.n]<xfc[0])or(EA.t>=EA.tf);

if EA.y[EA.n]<xfc[0] then

f1:=sqrt(sqr(EA.y[EA.n]-xfc[0])+sqr(EA.y[EA.n+1]-xfc[1]))

else f1:=infinity;

Form15:=TForm15.create(self);

Form15.ShowModal;

End;

Procedure TForm2.FormCreate(Sender: TObject);

var

i,j:integer;

Begin

color:=RGB(180,240,180);

StringGrid1.ColCount:=L1;

StringGrid1.RowCount:=L1;

for i:=0 to L1-1 do

for j:=0 to L1-1 do

StringGrid1.Cells[j,i]:=inttostr(Psi1[i,j]);

StringGrid2.ColWidths[1]:=96;

StringGrid2.RowCount:=p1;

for i:=0 to p1-1 do

begin

StringGrid2.Cells[0,i]:=inttostr(i);

StringGrid2.Cells[1,i]:=floattostrf(q1[i],ffFixed,8,5);

end;

StringGrid3.ColWidths[1]:=96;

StringGrid3.RowCount:=ny1;

for i:=0 to ny1-1 do

begin

StringGrid3.Cells[0,i]:=inttostr(i);

StringGrid3.Cells[1,i]:=floattostrf(qymin1[i],ffFixed,8,5);

end;

Edit1.Text:=floattostr(dt1);

Edit2.Text:=floattostr(dtp);

Edit3.Text:=floattostr(tf1);

End;

Procedure TForm2.StringGrid1Click(Sender: TObject);

Begin

Label4.Caption:='Psi['+inttostr(StringGrid1.Row)+','+

Inttostr(StringGrid1.Col)+']';

End;

END.

unit Unit3;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Grids;

type

TForm3 = class(TForm)

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

Label1: TLabel;

Label2: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Label3: TLabel;

Label4: TLabel;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

Uses Unit1;

{$R *.dfm}

Procedure TForm3.Button1Click(Sender: TObject);

var

i:integer;

Begin

for i:=0 to EA.n-1 do

x01[i]:=strtofloat(StringGrid1.Cells[1,i]);

for i:=1 to EA.m do

begin

umin1[i-1]:=strtofloat(StringGrid2.Cells[1,i]);

umax1[i-1]:=strtofloat(StringGrid2.Cells[2,i]);

end;

dt1:=strtofloat(Edit1.Text);

tf1:=strtofloat(Edit2.Text);

EA.Setx0(x01);

EA.Setuogr(umin1,umax1);

EA.Setdt(dt1);

EA.Settf(tf1);

close;

End;

Procedure TForm3.FormCreate(Sender: TObject);

var

i:integer;

Begin

color:=RGB(200,110,210);

StringGrid1.RowCount:=EA.n;

StringGrid1.ColWidths[1]:=96;

for i:=0 to EA.n-1 do

begin

StringGrid1.Cells[0,i]:=inttostr(i);

StringGrid1.Cells[1,i]:=floattostrf(x01[i],ffFixed,8,4);

end;

StringGrid2.RowCount:=EA.m+1;

StringGrid2.ColWidths[1]:=96;

StringGrid2.ColWidths[2]:=96;

StringGrid2.Cells[1,0]:='umin';

StringGrid2.Cells[2,0]:='umax';

for i:=1 to EA.m do

begin

StringGrid2.Cells[0,i]:=inttostr(i-1);

StringGrid2.Cells[1,i]:=floattostrf(umin1[i-1],ffFixed,8,4);

StringGrid2.Cells[2,i]:=floattostrf(umax1[i-1],ffFixed,8,4);

end;

Edit1.Text:=floattostrf(dt1,ffFixed,6,4);

Edit2.Text:=floattostrf(tf1,ffFixed,6,4);

End;

END.

unit Unit6;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm6 = class(TForm)

Edit1: TEdit;

Label1: TLabel;

Edit2: TEdit;

Label2: TLabel;

Edit3: TEdit;

Label3: TLabel;

Edit4: TEdit;

Label4: TLabel;

Edit5: TEdit;

Label5: TLabel;

Label6: TLabel;

Edit6: TEdit;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form6: TForm6;

implementation

Uses Unit1;

{$R *.dfm}

Procedure TForm6.Button1Click(Sender: TObject);

Begin

L1:=strtoint(Edit1.Text);

kp1:=strtoint(Edit2.Text);

kr1:=strtoint(Edit3.Text);

kw1:=strtoint(Edit4.Text);

kv1:=strtoint(Edit5.Text);

Mout1:=strtoint(Edit6.Text);

close;

End;

Procedure TForm6.FormCreate(Sender: TObject);

Begin

color:=RGB(200,250,200);

Edit1.Text:=inttostr(L1); // dimension of network operator matrix

Edit2.Text:=inttostr(kp1); //cardinal of set of variables

Edit3.Text:=inttostr(kr1); //cardinel of set of parameters

Edit4.Text:=inttostr(kw1); //cardinal of set of unary operations

Edit5.Text:=inttostr(kv1); //cardinal of set of binary operations

Edit6.Text:=inttostr(Mout1);// number of outputs

End;

end.

unit Unit7;

//*********************************************************

INTERFACE

//*********************************************************

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics,

Controls, Forms, Dialogs, StdCtrls, Grids;

type

TForm7 = class(TForm)

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

Label1: TLabel;

Label2: TLabel;

StringGrid3: TStringGrid;

StringGrid4: TStringGrid;

StringGrid5: TStringGrid;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

StringGrid6: TStringGrid;

Label6: TLabel;

Label7: TLabel;

StringGrid7: TStringGrid;

Label8: TLabel;

Button1: TButton;

Button2: TButton;

Memo1: TMemo;

SaveDialog1: TSaveDialog;

Button3: TButton;

OpenDialog1: TOpenDialog;

Button4: TButton;

procedure Button4Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure StringGrid6Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

Cyfr:set of char=['0'..'9'];

var

Form7: TForm7;

//*********************************************************

IMPLEMENTATION

//*********************************************************

Uses Unit1;

{$R *.dfm}

Procedure TForm7.Button1Click(Sender: TObject);

var

i,j:integer;

Begin

for i:=0 to kW1-1 do

O1s1[i]:=strtoint(StringGrid1.Cells[i,0]);

for i:=0 to kV1-1 do

O2s1[i]:=strtoint(StringGrid2.Cells[i,0]);

for i:=0 to kp1-1 do

Pnum1[i]:=strtoint(StringGrid3.Cells[i,0]);

for i:=0 to kr1-1 do

Rnum1[i]:=strtoint(StringGrid4.Cells[i,0]);

for i:=0 to Mout1-1 do

Dnum1[i]:=strtoint(StringGrid5.Cells[i,0]);

for i:=0 to L1-1 do

for j:=0 to L1-1 do

Psi1[i,j]:=strtoint(StringGrid6.Cells[j,i]);

for i:=0 to p1-1 do

q1[i]:=strtofloat(StringGrid7.Cells[1,i]);

EA.NOP.SetO1s(O1s1);

EA.NOP.SetO2s(O2s1);

EA.NOP.SetPnum(Pnum1);

EA.NOP.SetRnum(Rnum1);

EA.NOP.SetDnum(Dnum1);

EA.NOP.SetPsi(Psi1);

EA.Setq(q1);

Close;

End;

Procedure TForm7.Button2Click(Sender: TObject);

var

i,j:integer;

s:string;

Begin

Savedialog1.FileName:='Psi.txt';

if Savedialog1.Execute then

begin

Memo1.clear;

Memo1.Lines.Add('*******************');

Memo1.Lines.Add(label1.Caption);

s:='';

for j:=0 to StringGrid1.ColCount-1 do

s:=s+StringGrid1.Cells[j,0]+' ';

Memo1.Lines.Add(s);

Memo1.Lines.Add('*******************');

Memo1.Lines.Add(label2.Caption);

s:='';

for j:=0 to StringGrid2.ColCount-1 do

s:=s+StringGrid2.Cells[j,0]+' ';

Memo1.Lines.Add(s);

Memo1.Lines.Add('*******************');

Memo1.Lines.Add(label3.Caption);

s:='';

for j:=0 to StringGrid3.ColCount-1 do

s:=s+StringGrid3.Cells[j,0]+' ';

Memo1.Lines.Add(s);

Memo1.Lines.Add('*******************');

Memo1.Lines.Add(label4.Caption);

s:='';

for j:=0 to StringGrid4.ColCount-1 do

s:=s+StringGrid4.Cells[j,0]+' ';

Memo1.Lines.Add(s);

Memo1.Lines.Add('*******************');

Memo1.Lines.Add(label5.Caption);

s:='';

for j:=0 to StringGrid5.ColCount-1 do

s:=s+StringGrid5.Cells[j,0]+' ';

Memo1.Lines.Add(s);

Memo1.Lines.Add('*******************');

Memo1.Lines.Add(label6.Caption);

for i:=0 to StringGrid6.RowCount-1 do

begin

s:='';

for j:=0 to StringGrid6.ColCount-1 do

s:=s+StringGrid6.Cells[j,i]+' ';

Memo1.Lines.Add(s);

end;

Memo1.Lines.Add('*******************');

Memo1.Lines.Add(Label8.Caption);

for i:=0 to StringGrid7.RowCount-1 do

Memo1.Lines.Add(StringGrid7.Cells[1,i]);

Memo1.Lines.SaveToFile(Savedialog1.FileName);

Memo1.Clear;

for i:=0 to StringGrid6.RowCount-1 do

begin

s:='';

for j:=0 to StringGrid6.ColCount-1 do

s:=s+StringGrid6.Cells[j,i]+' ';

Memo1.Lines.Add(s);

end;

Memo1.Lines.SaveToFile('Psi00.txt');

Memo1.Clear;

for i:=0 to StringGrid7.RowCount-1 do

Memo1.Lines.Add(StringGrid7.Cells[1,i]);

Memo1.Lines.SaveToFile('q00.txt');

end;

End;

Procedure TForm7.Button3Click(Sender: TObject);

var

i,j,k:integer;

s,s1:string;

Begin

if OpenDialog1.Execute then

begin

memo1.Lines.LoadFromFile(OpenDialog1.FileName);

for i:=0 to L1-1 do

begin

s:=memo1.Lines[i];

k:=1;

for j:=0 to L1-1 do

begin

s1:='';

while s[k] in Cyfr do

begin

s1:=s1+s[k];

k:=k+1;

end;

if s[k]=' ' then

StringGrid6.Cells[j,i]:=s1;

k:=k+1;

while (k<length(s))and(s[k]=' ') do k:=k+1;

end;

end;

end;

End;

Procedure TForm7.Button4Click(Sender: TObject);

var

i,j:integer;

s:string;

Begin

if Opendialog1.Execute then

begin

memo1.Clear;

memo1.Lines.LoadFromFile(Opendialog1.FileName);

for i:=0 to p1-1 do

stringGrid7.cells[1,i]:=memo1.Lines[i];

end;

End;

Procedure TForm7.FormCreate(Sender: TObject);

var

i,j:integer;

Begin

color:=RGB(240,240,100);

StringGrid1.ColCount:=kw1;

StringGrid2.ColCount:=kv1;

StringGrid3.ColCount:=kp1;

StringGrid4.ColCount:=kr1;

StringGrid5.ColCount:=Mout1;

StringGrid6.ColCount:=L1;

StringGrid6.RowCount:=L1;

StringGrid7.RowCount:=p1;

for i:=0 to p1-1 do

StringGrid7.Cells[0,i]:=inttostr(i);

StringGrid7.ColWidths[1]:=108;

for i:=0 to kW1-1 do

StringGrid1.Cells[i,0]:=inttostr(O1s1[i]);

for i:=0 to kV1-1 do

StringGrid2.Cells[i,0]:=inttostr(O2s1[i]);

for i:=0 to kP1-1 do

StringGrid3.Cells[i,0]:=inttostr(Pnum1[i]);

for i:=0 to kR1-1 do

StringGrid4.Cells[i,0]:=inttostr(Rnum1[i]);

for i:=0 to Mout1-1 do

StringGrid5.Cells[i,0]:=inttostr(Dnum1[i]);

for i:=0 to L1-1 do

for j:=0 to L1-1 do

StringGrid6.Cells[j,i]:=inttostr(Psi1[i,j]);

for i:=0 to p1-1 do

stringgrid7.Cells[1,i]:=floattostrf(q1[i],ffFixed,8,5);

End;

Procedure TForm7.StringGrid6Click(Sender: TObject);

Begin

Label7.Caption:='Psi['+inttostr(StringGrid6.Row)+','+

inttostr(StringGrid6.Col)+']';

End;

END.

unit Unit8;

//*********************************************************

INTERFACE

//*********************************************************

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm8 = class(TForm)

Edit1: TEdit;

Label1: TLabel;

Edit2: TEdit;

Label2: TLabel;

Edit3: TEdit;

Label3: TLabel;

Edit4: TEdit;

Label4: TLabel;

Edit5: TEdit;

Label5: TLabel;

Edit6: TEdit;

Label6: TLabel;

Edit7: TEdit;

Label7: TLabel;

Edit8: TEdit;

Label8: TLabel;

Edit9: TEdit;

Label9: TLabel;

Edit10: TEdit;

Label10: TLabel;

Edit11: TEdit;

Label11: TLabel;

Edit12: TEdit;

Label12: TLabel;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form8: TForm8;

//*********************************************************

IMPLEMENTATION

//*********************************************************

Uses Unit1;

{$R *.dfm}

Procedure TForm8.Button1Click(Sender: TObject);

Begin

hh1:=strtoint(Edit1.Text);

pp1:=strtoint(Edit2.Text);

rr1:=strtoint(Edit3.Text);

nfu1:=strtoint(Edit4.Text);

lchr1:=strtoint(Edit5.Text);

p1:=strtoint(Edit6.Text);

c1:=strtoint(Edit7.Text);

d1:=strtoint(Edit8.Text);

Epo1:=strtoint(Edit9.Text);

kel1:=strtoint(Edit10.Text);

alfa1:=strtofloat(Edit11.Text);

pmut1:=strtofloat(Edit12.Text);

close;

End;

Procedure TForm8.FormCreate(Sender: TObject);

Begin

color:=RGB(250,100,250);

Edit1.Text:=inttostr(hh1); //number of chromosomes in an initial population

Edit2.Text:=inttostr(pp1); // number of generations

Edit3.Text:=inttostr(rr1); // number of couples in one generation

Edit4.Text:=inttostr(nfu1); // number of functionals

Edit5.Text:=inttostr(lchr1); // number of variations in one chromosome

Edit6.Text:=inttostr(p1); // number of serching parameters

Edit7.Text:=inttostr(c1); // number of bits for integer part

Edit8.Text:=inttostr(d1); // number of bits for fractional part

Edit9.Text:=inttostr(Epo1);//number of ganerations between exchange of basic NOM

Edit10.Text:=inttostr(kel1); // number of elitaring chromosomes

Edit11.Text:=floattostr(alfa1); // parameter for crossover

Edit12.Text:=floattostr(pmut1); // probability of mutation

End;

END.

unit Unit9;

//*********************************************************

INTERFACE

//*********************************************************

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

TForm9 = class(TForm)

Edit1: TEdit;

Label1: TLabel;

Edit2: TEdit;

Label2: TLabel;

Label3: TLabel;

Edit3: TEdit;

Edit4: TEdit;

Label4: TLabel;

Edit5: TEdit;

Label5: TLabel;

Edit6: TEdit;

Label6: TLabel;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form9: TForm9;

//*********************************************************

IMPLEMENTATION

//*********************************************************

Uses Unit1;

{$R *.dfm}

Procedure TForm9.Button1Click(Sender: TObject);

Begin

pp1:=strtoint(Edit1.Text);

rr1:=strtoint(Edit2.Text);

Epo1:=strtoint(Edit3.Text);

kel1:=strtoint(Edit4.Text);

alfa1:=strtofloat(Edit5.Text);

pmut1:=strtofloat(Edit6.Text);

EA.PP:=pp1;

EA.RR:=rr1;

EA.Epo:=Epo1;

EA.kel:=kel1;

EA.alfa:=alfa1;

EA.pmut:=pmut1;

close;

End;

Procedure TForm9.FormCreate(Sender: TObject);

Begin

color:=RGB(220,100,250);

Edit1.Text:=inttostr(pp1);

Edit2.Text:=inttostr(rr1);

Edit3.Text:=inttostr(Epo1);

Edit4.Text:=inttostr(kel1);

Edit5.Text:=floattostr(alfa1);

Edit6.Text:=floattostr(pmut1);

End;

END.

unit TGAModelUnit;

interface

uses

Windows, Messages, SysUtils,

Variants, Classes, Graphics,

Controls, Forms,

Dialogs, ComCtrls, StdCtrls,

TeEngine, Series, ExtCtrls, TeeProcs, Chart;

type

TForm11 = class(TForm)

Chart1: TChart;

Series1: TLineSeries;

ListBox1: TListBox;

Button4: TButton;

SaveDialog1: TSaveDialog;

ComboBox1: TComboBox;

ComboBox2: TComboBox;

Label2: TLabel;

Label3: TLabel;

Button6: TButton;

Label1: TLabel;

Label4: TLabel;

Label5: TLabel;

Series2: TLineSeries;

Button1: TButton;

procedure Button1Click(Sender: TObject);

procedure ListBox1Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure Button6Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

// TArrReal=array of real;

var

Form11: TForm11;

implementation

uses unit1;

{$R *.dfm}

Procedure TForm11.ListBox1Click(Sender: TObject);

Begin

label1.Caption:='t='+floattostrf(tm[listbox1.itemindex],ffFixed,8,4);

End;

Procedure TForm11.Button1Click(Sender: TObject);

const

deltc=0.1;

var

i:integer;

x,y,alf:real;

Begin

Series2.Clear;

Series2.XValues.Order:=loNone;

if (Combobox1.ItemIndex=3)and(Combobox2.ItemIndex=1) then

begin

alf:=0;

repeat

x:=EA.qy[1]*cos(alf)+EA.qy[0];

y:=EA.qy[1]*sin(alf);

alf:=alf+deltc;

series2.AddXY(x,y);

until alf>2*pi+deltc;

end;

if (Combobox1.ItemIndex=5)and(Combobox2.ItemIndex=1) then

begin

x:=EA.qy[0]-EA.qy[1];

y:=0;

series2.AddXY(x,y);

x:=EA.qy[0]-EA.qy[1];

y:=EA.qy[2];

series2.AddXY(x,y);

x:=EA.qy[0]+EA.qy[1];

y:=EA.qy[2];

series2.AddXY(x,y);

x:=EA.qy[0]+EA.qy[1];

y:=0;

series2.AddXY(x,y);

end;

End;

Procedure TForm11.Button4Click(Sender: TObject);

Begin

if savedialog1.execute then

Chart1.SaveToBitmapFile(savedialog1.FileName);

End;

Procedure TForm11.FormCreate(Sender: TObject);

var

i:integer;

Begin

Color:=RGB(200,170,220);

ComboBox1.Clear;

ComboBox2.Clear;

ComboBox1.Items.Add('t');

ComboBox2.Items.Add('t');

for i:=0 to EA.lv-1 do

begin

ComboBox1.Items.Add('x['+inttostr(i)+']');

ComboBox2.Items.Add('x['+inttostr(i)+']');

end;

for i:=0 to EA.m-1 do

begin

ComboBox1.Items.Add('u['+inttostr(i)+']');

ComboBox2.Items.Add('u['+inttostr(i)+']');

end;

ComboBox1.ItemIndex:=1;

ComboBox2.ItemIndex:=0;

Label4.Caption:='F1='+floattostrf(f0,ffGeneral,8,5);

Label5.Caption:='F2='+floattostrf(f1,ffGeneral,8,5);

End;

Procedure TForm11.Button6Click(Sender: TObject);

var

i:integer;

argm,funm:array of real;

Begin

setlength(argm,length(tm));

setlength(funm,length(tm));

if Combobox1.ItemIndex=0 then

for i:=0 to high(tm) do

funm[i]:=tm[i]

else

if ComboBox1.ItemIndex<=EA.lv then

for i:=0 to high(tm) do

funm[i]:=xm[ComboBox1.itemindex-1,i]

else

for i:=0 to high(tm) do

funm[i]:=um[ComboBox1.itemindex-EA.lv-1,i];

if Combobox2.ItemIndex=0 then

for i:=0 to high(tm) do

argm[i]:=tm[i]

else

if ComboBox2.ItemIndex<=EA.lv then

for i:=0 to high(tm) do

argm[i]:=xm[ComboBox2.itemindex-1,i]

else

for i:=0 to high(tm) do

argm[i]:=um[ComboBox2.itemindex-EA.lv-1,i];

Series1.Clear;

Series2.Clear;

Series1.XValues.Order:=loNone;

for i:=0 to high(tm) do

Series1.AddXY(argm[i],funm[i]);

ListBox1.Clear;

for i:=0 to high(tm) do

ListBox1.Items.Add(FloattoStrf(funm[i],ffGeneral,10,5));

End;

END.

unit Calc3;

interface

const

infinity=1e8;

eps=1e-8;

pokmax=16;

function Ro_1(z:real):real;

function Ro_2(z:real):real;

function Ro_3(z:real):real;

function Ro_4(z:real):real;

function Ro_5(z:real):real;

function Ro_6(z:real):real;

function Ro_7(z:real):real;

function Ro_8(z:real):real;

function Ro_9(z:real):real;

function Ro_10(z:real):real;

function Ro_11(z:real):real;

function Ro_12(z:real):real;

function Ro_13(z:real):real;

function Ro_14(z:real):real;

function Ro_15(z:real):real;

function Ro_16(z:real):real;

function Ro_17(z:real):real;

function Ro_18(z:real):real;

function Ro_19(z:real):real;

function Ro_20(z:real):real;

function Ro_21(z:real):real;

function Ro_22(z:real):real;

function Ro_23(z:real):real;

function Ro_24(z:real):real;

function Xi_0(z1,z2:real):real;

function Xi_1(z1,z2:real):real;

function Xi_2(z1,z2:real):real;

function Xi_3(z1,z2:real):real;

function Xi_4(z1,z2:real):real;

implementation

function Ro_1(z:real):real;

Begin

result:=z;

End;

function Ro_2(z:real):real;

Begin

if abs(z)>sqrt(infinity) then result:=infinity

else result:=sqr(z);

End;

function Ro_3(z:real):real;

Begin

result:=-z;

End;

function Ro_4(z:real):real;

Begin

result:=Ro_10(z)*sqrt(abs(z));

End;

Function Ro_5(z:real):real;

Begin

if abs(z)>eps then result:=1/z

else result:=Ro_10(z)/eps;

End;

function Ro_6(z:real):real;

Begin

if z>-ln(eps) then result:=-ln(eps)

else result:=exp(z);

End;

function Ro_7(z:real):real;

Begin

if abs(z)<exp(-pokmax) then result:=ln(eps)

else result:=ln(abs(eps));

End;

function Ro_8(z:real):real;

Begin

if abs(z)>-ln(eps) then

result:=Ro_10(z)

else

result:=(1-exp(-z))/(1+exp(-z));

End;

function Ro_9(z:real):real;

Begin

if z>=0 then result:=1

else result:=0;

End;

function Ro_10(z:real):real;

Begin

if z>=0 then result:=1

else

result:=-1;

End;

function Ro_11(z:real):real;

Begin

result:=cos(z);

End;

function Ro_12(z:real):real;

Begin

result:=sin(z);

End;

function Ro_13(z:real):real;

Begin

result:=arctan(z);

End;

function Ro_14(z:real):real;

Begin

if abs(z)>Ro_15(infinity) then result:=Ro_10(z)*infinity

else result:=sqr(z)*z;

End;

function Ro_15(z:real):real;

Begin

if abs(z)<eps then result:=Ro_10(z)*eps

else

result:=Ro_10(z)*exp(ln(abs(z))/3);

End;

function Ro_16(z:real):real;

Begin

if abs(z)<1 then result:=z

else result:=Ro_10(z);

End;

function Ro_17(z:real):real;

Begin

result:=Ro_10(z)*ln(abs(z)+1);

End;

function Ro_18(z:real):real;

Begin

if abs(z)>-ln(eps) then

result:=Ro_10(z)*infinity

else

result:=Ro_10(z)*(exp(abs(z))-1);

End;

function Ro_19(z:real):real;

Begin

if abs(z)>-ln(eps) then result:=0

else result:=Ro_10(z)*exp(-abs(z));

End;

function Ro_20(z:real):real;

Begin

if z>eps then result:=1

else

if z<0 then result:=-1

else result:=3*z/sqr(eps)-2*Ro_14(z)/sqr(eps)/eps;

End;

function Ro_21(z:real):real;

Begin

if z>eps/2 then result:=1

else

if z<-eps/2 then result:=-1

else result:=3*z/sqr(eps)-4*Ro_14(z)/sqr(eps)/eps;

End;

function Ro_22(z:real):real;

Begin

if abs(z)>-ln(eps) then result:=0

else result:=exp(abs(z));

End;

function Ro_23(z:real):real;

Begin

if abs(z)>1/eps then result:=-Ro_10(z)/eps

else result:=z-z*sqr(z);

End;

function Ro_24(z:real):real;

Begin

if z>-ln(eps) then result:=eps/(1+eps)

else result:=1/(1+exp(-z));

End;

function Xi_0(z1,z2:real):real;

Begin

result:=z1+z2;

End;

function Xi_1(z1,z2:real):real;

Begin

result:=z1*z2;

End;

function Xi_2(z1,z2:real):real;

Begin

if z1>=z2 then result:=z1

else result:=z2;

End;

function Xi_3(z1,z2:real):real;

Begin

if z1<z2 then result:=z1

else result:=z2;

End;

function Xi_4(z1,z2:real):real;

Begin

result:=z1+z2-z1*z2;

End;

function Xi_5(z1,z2:real):real;

Begin

result:=sqrt(sqr(z1)+sqr(z2));

End;

function Xi_6(z1,z2:real):real;

Begin

result:=abs(z1)+abs(z2);

End;

function Xi_7(z1,z2:real):real;

Begin

result:=Xi_2(abs(z1),abs(z2));

End;

END.

Unit UnitAdaptObjects;

//*********************************************************

INTERFACE

//*********************************************************

Uses Calc3,SysUtils;

type

TArrInt=array of integer;

TArrArrInt=array of TArrInt;

TArr4Int=array [0..3]of integer;

TArrArr4Int=array of TArr4Int;

TArrArrArr4int=array of TArrArr4Int;

TArrReal=array of real;

TArrArrReal=array of TArrReal;

TArrString=array of string;

TProc=Procedure;

TNetOper=class(TObject)

L:integer; //dimention of network operator matrix

Mout:integer;//number of outputs

Vs:TArrReal;//set of variables

Cs:TArrReal;//set of parameters

O1s:TArrInt;//set of unary operations

O2s:TArrInt;//set of binary operations

kP:integer;//cardinal of the set of variables

kR:integer;//cardinal of the set of parameters

kW:integer;//cardinal of the set of unary operations

kV:integer;//cardinal of the set of binary operations

Pnum:TArrInt;//vector of number nodes for variables

Rnum:TArrInt;//vector of number nodes for parameters

Dnum:TArrInt;//vector of number nodes for outputs

z:TArrReal;//vector of nodes

zs:TArrString;//string for mathematical expression

Psi,Psi0:TArrArrInt;//Network operator matrices

Constructor Create(L1,Mout1,kp1,kr1,kw1,kv1:integer);//create of NOP

Procedure SetVs(vs1:TArrReal);

Procedure SetCs(cs1:TArrReal);

Procedure SetO1s(o1s1:TArrInt);

Procedure SetO2s(o2s1:TArrInt);

Procedure SetPnum(pnum1:TArrInt);

Procedure SetRnum(rnum1:TArrInt);

Procedure SetDnum(dnum1:TArrInt);

Procedure SetPsiBas(Psi1:TArrArrInt);

Procedure SetPsi(Psi1:TArrArrInt);

Procedure GenVar(var w:TArr4Int);

Procedure Variations(w:TArr4Int);

Procedure RPControl;

Procedure PsitoPas;

Procedure PsitoTex;

Procedure PsitoPasStr;

Procedure PsitoTexStr;

Procedure ReadPsi(var Psi1:TArrArrInt);

Procedure ReadPsi0(var Psi1:TArrArrInt);

end;

TGANOP=class(TObject)

PopChrStr:TArrArrArr4Int;//array for structural parts of chromosomes

PopChrPar:TArrArrInt;//array for perametrical parts of chromosomes

HH:integer;// number of cromosomes in initial population

RR:integer;// number of couples in one generation

PP:integer;// number of generations

nfu:integer;//number of functionals

lchr:integer;//length of structural part of chromosome

Epo:integer;//number of generations between epochs

kel:integer;//number of elitared chromosomes

Fuh:TArrArrReal;// values of functionals for each chromosome

Lh:TArrInt;// values distance to Pareto set

Pareto:TArrInt;// Pareto set

Son1s,Son2s,Son3s,Son4s:TArrArr4Int;//structural part of sons

Son1p,Son2p,Son3p,Son4p:TArrInt;//parametrical part of sons

L1,L2,L3,L4:integer;//values distance to Pareto set for sons

Fu1,Fu2,Fu3,Fu4:TArrReal;// values of functionals for sons

alfa:real;//parameter for select of parents

pmut:real;//probability of mutation

NOP:TNetOper;// Network operator

p:integer;//number of parameters

c:integer;// number of bit for integer part

d:integer;// number of bit for fractional part

q:TArrReal;//vector of parameters

zb:TArrInt;//additional vector

EndGeneration:TProc;

Constructor Create(hh1,pp1,rr1,nfu1,lchr1,p1,c1,d1,

Epo1,kel1:integer;alfa1,pmut1:real;

L1,Mout1,kp1,kr1,kw1,kv1:integer);

Procedure GenAlgorithm;// genetic algorithm for structural-parametrical optimization

Procedure GenAlgorithm1;// genetic algorithm for parametrical optimization

Function Rast(Fu:TArrReal):integer;//distance to Pareto set

Procedure GreytoVector(y:TArrInt);

Procedure VectortoGrey(var y: TArrInt);

Procedure ChoosePareto;

Procedure ImproveChrom(q:TArrReal;var StrChrom: TArrArr4Int);

Procedure Setq(q1:TArrReal);

Procedure ReadFunc(k:integer;var Fu1:TArrReal);

Procedure Readq(var q1:TArrReal);

Procedure ReadChromosome(k:integer;var q1:TArrReal;var Psi1:TArrArrInt);

Procedure Func0(var Fu:TArrReal); virtual;//Values of functionals

end;

TModel=class(TGANOP)

x:TArrReal;// vector of condition

qy:TArrReal;//vextor of undefined parameters

x0:TArrReal;// vector of initial condition

xs:TArrReal;//

fb:TArrReal;

fa:TArrReal;

su:TArrReal;

su1:TArrReal;

u:TArrReal;// vector of control

umin:TArrReal;// vector of control

umax:TArrReal;// vector of control

y:TArrReal;// vector of vewing

n:integer;

ny:integer;//dimention of undefined parameters

qymax,qymin:TArrReal;

ix,ixmax:TArrInt;

stepsqy:TArrReal;//vector of steps of undefine parameters

m:integer;

lv:integer;

dt:real;

t:real;

tf:real;

Constructor Create(hh1,pp1,rr1,nfu1,lchr1,p1,c1,d1,

Epo1,kel1:integer;alfa1,pmut1:real;

L1,Mout1,kp1,kr1,kw1,kv1,n1,m1,ll1,ny1:integer);

Procedure Euler2;

Procedure Func(var Fu:TArrReal); virtual;

Procedure Func0(var Fu:TArrReal); override;

Procedure Initial;virtual;

Procedure Viewer;virtual;

Procedure Integr;

Procedure LexPM(var ix:tArrInt;var flag:boolean);

Procedure OgrUpr;

Procedure RP(t1:real;x1:TArrReal;var f1:TArrReal);virtual;//Правые части

Procedure Setdt(dt1:real);

Procedure Setixmax(ix1:TArrInt);

Procedure Setqymax(qymax1:TArrReal);

Procedure Setqymin(qymin1:TArrReal);

Procedure Setstepsqy(stepsqy1:TArrReal);

Procedure Settf(tf1:real);

Procedure Setuogr(umin1,umax1:TArrReal);

Procedure Setx0(x01:TArrReal);

Procedure Upr;

end;

//*********************************************************

IMPLEMENTATION

//*********************************************************

{ TNetOper }

Constructor TNetOper.Create(L1, Mout1, kp1, kr1, kw1, kv1: integer);

Begin

L:=L1;

kP:=kp1;

kR:=kr1;

kW:=kw1;

kV:=kv1;

Mout:=Mout1;

Setlength(Psi,L,L);

Setlength(Psi0,L,L);

Setlength(z,L);

Setlength(zs,L);

Setlength(Vs,kP);

Setlength(Cs,kR);

Setlength(O1s,kW);

Setlength(O2s,kV);

Setlength(Pnum,kP);

Setlength(Rnum,kR);

Setlength(Dnum,Mout);

End;

Procedure TNetOper.SetCs(cs1: TArrReal);

var

i:integer;

Begin

for i:=0 to kR-1 do

Cs[i]:=cs1[i];

End;

Procedure TNetOper.SetDnum(dnum1: TArrInt);

var

i:integer;

Begin

for i:=0 to Mout-1 do

Dnum[i]:=dnum1[i];

End;

Procedure TNetOper.SetO1s(o1s1: TArrInt);

var

i:integer;

Begin

for i:=0 to kW-1 do

O1s[i]:=o1s1[i];

End;

Procedure TNetOper.SetO2s(o2s1: TArrInt);

var

i:integer;

Begin

for i:=0 to kV-1 do

O2s[i]:=o2s1[i];

End;

Procedure TNetOper.SetPnum(pnum1: TArrInt);

var

i:integer;

Begin

for i:=0 to kP-1 do

Pnum[i]:=pnum1[i];

End;

Procedure TNetOper.SetPsi(Psi1:TArrArrInt);

var

i,j:integer;

Begin

for i:=0 to L-1 do

for j:= 0 to L-1 do

Psi[i,j]:=Psi1[i,j];

End;

Procedure TNetOper.SetPsiBas(Psi1: TArrArrInt);

var

i,j:integer;

Begin

for i:=0 to L-1 do

for j:= 0 to L-1 do

Psi0[i,j]:=Psi1[i,j];

End;

Procedure TNetOper.SetRnum(rnum1: TArrInt);

var

i:integer;

Begin

for i:=0 to kR-1 do

Rnum[i]:=rnum1[i];

End;

Procedure TNetOper.SetVs(Vs1: TArrReal);

var

i:integer;

Begin

for i:=0 to high(Vs1) do

Vs[i]:=vs1[i];

End;

Procedure TNetOper.ReadPsi(var Psi1: TArrArrInt);

var

i,j:integer;

Begin

for i:=0 to L-1 do

for j:=0 to L-1 do

Psi1[i,j]:=Psi[i,j];

End;

Procedure TNetOper.ReadPsi0(var Psi1: TArrArrInt);

var

i,j:integer;

Begin

for i:=0 to L-1 do

for j:=0 to L-1 do

Psi1[i,j]:=Psi0[i,j];

End;

Procedure TNetOper.RPControl;

var

i,j:integer;

zz:real;

Begin

for i:=0 to L-1 do

case psi[i,i] of

0,4: z[i]:=0;

1: z[i]:=1;

2: z[i]:=-infinity;

3: z[i]:=infinity;

end;

for i:=0 to kP-1 do

z[Pnum[i]]:=Vs[i];

for i:=0 to kR-1 do

z[Rnum[i]]:=Cs[i];

for i:=0 to L-2 do

for j:=i+1 to L-1 do

if Psi[i,j]<>0 then

begin

case Psi[i,j] of

1: zz:=Ro_1(z[i]);

2: zz:=Ro_2(z[i]);

3: zz:=Ro_3(z[i]);

4: zz:=Ro_4(z[i]);

5: zz:=Ro_5(z[i]);

6: zz:=Ro_6(z[i]);

7: zz:=Ro_7(z[i]);

8: zz:=Ro_8(z[i]);

9: zz:=Ro_9(z[i]);

10: zz:=Ro_10(z[i]);

11: zz:=Ro_11(z[i]);

12: zz:=Ro_12(z[i]);

13: zz:=Ro_13(z[i]);

14: zz:=Ro_14(z[i]);

15: zz:=Ro_15(z[i]);

16: zz:=Ro_16(z[i]);

17: zz:=Ro_17(z[i]);

18: zz:=Ro_18(z[i]);

19: zz:=Ro_19(z[i]);

20: zz:=Ro_20(z[i]);

21: zz:=Ro_21(z[i]);

22: zz:=Ro_22(z[i]);

23: zz:=Ro_23(z[i]);

24: zz:=Ro_24(z[i]);

end;

case Psi[j,j] of

0: z[j]:=Xi_0(z[j],zz);

1: z[j]:=Xi_1(z[j],zz);

2: z[j]:=Xi_2(z[j],zz);

3: z[j]:=Xi_3(z[j],zz);

4: z[j]:=Xi_4(z[j],zz);

end;

end;

End;

Procedure TNetOper.Variations(w:TArr4Int);

// Элементарные операции

// 0 - замена недиагонального элемента

// 1 - замена диагонального элемента

// 2 - добавление дуги

// 3 - удаление дуги

var

i,j,s1,s2:integer;

Begin

if (w[0]<>0)or(w[1]<>0)or(w[2]<>0) then

case w[0] of

0: if Psi[w[1],w[2]]<>0 then Psi[w[1],w[2]]:=w[3];

1: Psi[w[1],w[1]]:=w[3];

2: if Psi[w[1],w[2]]=0 then Psi[w[1],w[2]]:=w[3];

3:

begin

s1:=0;

for i:=0 to w[2]-1 do

if Psi[i,w[2]]<>0 then s1:=s1+1;

s2:=0;

for j:=w[1]+1 to L-1 do

if (Psi[w[1],j]<>0)then s2:=s2+1;

if s1>1 then

if s2>1 then

Psi[w[1],w[2]]:=0;

end;

end;

End;

Procedure TNetOper.GenVar(var w:TArr4Int);

// Генерация элементарной операции

Function TestSource(j:integer):boolean;

// если j-номер узла источника, то возвращает false

var

i:integer;

flag:boolean;

Begin

flag:=true;

i:=0;

while(i<=high(Pnum)) and (j<>Pnum[i]) do i:=i+1;

if i<=high(Pnum) then flag:=false

else

begin

i:=0;

while(i<=high(Rnum)) and (j<>Rnum[i]) do i:=i+1;

if i<=high(Rnum) then flag:=false;

end;

result:=flag;

End;

Begin

w[0]:=random(4);

case w[0] of

0,2,3: // замена недиагонального элемента, добавление и удаление дуги

begin

w[1]:=random(L-1);

w[2]:=random(L-w[1]-1)+w[1]+1;

// while not TestSource(w[2]) do w[2]:=w[2]+1;

w[3]:=O1s[random(kW)];

end;

1: // замена диагонального элемента

begin

w[1]:=random(L);

// while not TestSource(w[1]) do w[1]:=w[1]+1;

w[2]:=w[1];

w[3]:=O2s[random(kV)];

end;

end;

End;

Procedure TNetOper.PsitoPas;

// It tranforms from Psi to Pascal

var

i,j:integer;

zz:string;

Begin

for i:=0 to L-1 do

case Psi[i,i] of

0,4: zs[i]:='0';

1: zs[i]:='1';

2: zs[i]:='-inf';

3: zs[i]:='inf';

end;

for i:=0 to kP-1 do

zs[Pnum[i]]:='x['+inttostr(i)+']';

for i:=0 to kR-1 do

zs[Rnum[i]]:='q['+inttostr(i)+']';

for i:=0 to L-2 do

begin

for j:=i+1 to L-1 do

if Psi[i,j]<>0 then

begin

if Psi[i,j]=1 then

zz:=zs[i]

else

zz:='Ro_'+inttostr(Psi[i,j])+'('+zs[i]+')';

if((Psi[j,j]=0)and(zs[j]='0'))or

((Psi[j,j]=1)and(zs[j]='1'))or

((Psi[j,j]=2)and(zs[j]='-inf'))or

((Psi[j,j]=3)and(zs[j]='inf'))or

((Psi[j,j]=4)and(zs[j]='0')) then

zs[j]:=zz

else

zs[j]:='Xi_'+inttostr(Psi[j,j])+'('+zs[j]+','+zz+')';

end;

end;

End;

Procedure TNetOper.PsitoPasStr;

var

i,j:integer;

Begin

for j:=L-1 downto 0 do

begin

zs[j]:='z'+inttostr(j)+'=';

case Psi[j,j] of

0: zs[j]:=zs[j]+'Sum(';

1: zs[j]:=zs[j]+'Prod(';

2: zs[j]:=zs[j]+'Min(';

3: zs[j]:=zs[j]+'Max(';

4: zs[j]:=zs[j]+'Pol(';

end;

for i:=j-1 downto 0 do

if Psi[i,j]<>0 then

if Psi[i,j]<>1 then

zs[j]:=zs[j]+'Ro_'+inttostr(Psi[i,j])+'(z_'+inttostr(i)+'),'

else

zs[j]:=zs[j]+'z_'+inttostr(i)+',';

if zs[j,length(zs[j])]=',' then

zs[j,length(zs[j])]:=')'

else

zs[j]:=zs[j]+')';

end;

for i:=0 to kP-1 do

zs[Pnum[i]]:='z_'+inttostr(Pnum[i])+'=x_'+inttostr(i);

for i:=0 to kR-1 do

zs[Rnum[i]]:='z_'+inttostr(Rnum[i])+'=q_'+inttostr(i);

End;

Procedure TNetOper.PsitoTex;

// It tranforms from Psi to LaTeX

var

i,j:integer;

zz:string;

Begin

for i:=0 to L-1 do

case Psi[i,i] of

0,4: zs[i]:='0';

1: zs[i]:='1';

2: zs[i]:='-\infinity';

3: zs[i]:='\infinity';

end;

for i:=0 to kP-1 do

zs[Pnum[i]]:='x_{'+inttostr(i)+'}';

for i:=0 to kR-1 do

zs[Rnum[i]]:='q_{'+inttostr(i)+'}';

for i:=0 to L-2 do

begin

for j:=i+1 to L-1 do

if Psi[i,j]<>0 then

begin

if Psi[i,j]=1 then

zz:=zs[i]

else

zz:='\rho_{'+inttostr(Psi[i,j])+'}('+zs[i]+')';

if((Psi[j,j]=0)and(zs[j]='0'))or

((Psi[j,j]=1)and(zs[j]='1'))or

((Psi[j,j]=2)and(zs[j]='-\infinity'))or

((Psi[j,j]=3)and(zs[j]='\infinity'))or

((Psi[j,j]=4)and(zs[j]='0')) then

zs[j]:=zz

else

zs[j]:='\chi_{'+inttostr(Psi[j,j])+'}('+zs[j]+','+zz+')';

end;

end;

End;

Procedure TNetOper.PsitoTexStr;

var

i,j:integer;

Begin

for j:=L-1 downto 0 do

begin

zs[j]:='$z_{'+inttostr(j)+'}=';

case Psi[j,j] of

2: zs[j]:=zs[j]+'\text{Min}(';

3: zs[j]:=zs[j]+'\text{Max}(';

4: zs[j]:=zs[j]+'\text{Pol}(';

end;

for i:=j-1 downto 0 do

if Psi[i,j]<>0 then

begin

if Psi[i,j]<>1 then

zs[j]:=zs[j]+'\rho_{'+inttostr(Psi[i,j])+'}(z_{'+inttostr(i)+'})'

else

zs[j]:=zs[j]+'z_{'+inttostr(i)+'}';

case Psi[j,j] of

0:zs[j]:=zs[j]+'+';

1:zs[j]:=zs[j]+'*';

end;

end;

if (zs[j,length(zs[j])]='+')or(zs[j,length(zs[j])]='*') then

zs[j,length(zs[j])]:=')'

else

zs[j]:=zs[j]+')';

zs[j]:=zs[j]+'$\\';

end;

for i:=0 to kP-1 do

zs[Pnum[i]]:='z_{'+inttostr(Pnum[i])+'}=x_{'+inttostr(i)+'}';

for i:=0 to kR-1 do

zs[Rnum[i]]:='z_{'+inttostr(Rnum[i])+'}=q_{'+inttostr(i)+'}';

End;

Procedure TGANOP.ChoosePareto;

var

i,j:integer;

Begin

j:=0;

for i:=0 to HH-1 do

if Lh[i]=0 then

begin

j:=j+1;

setlength(Pareto,j);

Pareto[j-1]:=i;

end;

End;

Constructor TGANOP.Create(hh1, pp1, rr1, nfu1, lchr1, p1, c1, d1, epo1,

kel1: integer; alfa1, pmut1: real; L1, Mout1,

kp1, kr1, kw1,kv1: integer);

Begin

Inherited Create;

HH:=hh1;

PP:=pp1;

RR:=rr1;

nfu:=nfu1;

lchr:=lchr1;

p:=p1;

c:=c1;

d:=d1;

Epo:=epo1;

kel:=kel1;

alfa:=alfa1;

pmut:=pmut1;

NOP:=TNetOper.Create(L1, Mout1, kp1, kr1, kw1, kv1);

Setlength(PopChrStr,HH,lchr);

Setlength(PopChrPar,HH,p*(c+d));

Setlength(Fuh,HH,nfu);

Setlength(Lh,HH);

Setlength(Fu1,nfu);

Setlength(Fu2,nfu);

Setlength(Fu3,nfu);

Setlength(Fu4,nfu);

Setlength(Son1s,lchr);

Setlength(Son2s,lchr);

Setlength(Son3s,lchr);

Setlength(Son4s,lchr);

Setlength(Son1p,p*(c+d));

Setlength(Son2p,p*(c+d));

Setlength(Son3p,p*(c+d));

Setlength(Son4p,p*(c+d));

SetLength(q,p);

SetLength(zb,p*(c+d));

End;

Procedure TGANOP.Func0(var Fu:TArrReal);

var

i:integer;

Begin

NOP.RPControl;

for i:=0 to nfu-1 do

Fu[i]:=NOP.z[NOP.Dnum[i]];

End;

Procedure TGANOP.GenAlgorithm;

// Генетический алгоритм

var

i,j,k,pt,rt,k1,k2,lmax,imax,ks1,ks2:integer;

ksi,su,su1,Fumax,Fumin:real;

FuhNorm:TArrArrreal;

Begin

setlength(FuhNorm,HH,nfu);

//generating population

NOP.SetPsiBas(NOP.Psi);

VectortoGrey(PopChrPar[0]);

for i:=0 to lchr-1 do

for j:=0 to 3 do

PopChrStr[0,i,j]:=0;

for i:=1 to HH-1 do

begin

for j:=0 to lchr-1 do

NOP.GenVar(PopChrStr[i,j]);

for j:=0 to p*(c+d)-1 do

PopChrPar[i,j]:=random(2);

end;

// calculating values of functionals

for i:=0 to HH-1 do

begin

NOP.SEtPsi(NOP.Psi0);

for j:=0 to lchr-1 do

NOP.Variations(PopChrStr[i,j]);

GreytoVector(PopChrPar[i]);

Func0(Fuh[i]);

end;

//caculating distances to Pareto set

for i:=0 to HH-1 do

Lh[i]:=Rast(Fuh[i]);

//Start of cycle for generations

pt:=1; // first current generation

repeat

//start of cycle for crossovering

rt:=1;//first couple for crossoving

repeat

//select of two parents

k1:=random(HH);

k2:=random(HH);

ksi:=random;

if (ksi<(1+alfa*Lh[k1])/(1+Lh[k1])) or

(ksi<(1+alfa*Lh[k2])/(1+Lh[k2])) then

begin

//if true

ks1:=random(lchr);

ks2:=random(p*(c+d));

//crossoving? creating four sons

for i:=0 to lchr-1 do

begin

Son1s[i]:=PopChrStr[k1,i];

Son2s[i]:=PopChrStr[k2,i];

end;

for i:=0 to ks2-1 do

begin

Son1p[i]:=PopChrPar[k1,i];

Son2p[i]:=PopChrPar[k2,i];

Son3p[i]:=PopChrPar[k1,i];

Son4p[i]:=PopChrPar[k2,i];

end;

for i:=ks2 to p*(c+d)-1 do

begin

Son1p[i]:=PopChrPar[k2,i];

Son2p[i]:=PopChrPar[k1,i];

Son3p[i]:=PopChrPar[k2,i];

Son4p[i]:=PopChrPar[k1,i];

end;

for i:=0 to ks1-1 do

begin

Son3s[i]:=PopChrStr[k1,i];

Son4s[i]:=PopChrStr[k2,i];

end;

for i:=ks1 to lchr-1 do

begin

Son3s[i]:=PopChrStr[k2,i];

Son4s[i]:=PopChrStr[k1,i];

end;

//mutation for 1st son

if random<pmut then

begin

son1p[random(p*(c+d))]:=random(2);

NOP.GenVar(son1s[random(lchr)]);

end;

//functional for 1st son

NOP.SetPsi(NOP.Psi0);;

for j:=0 to lchr-1 do

NOP.Variations(son1s[j]);

GreytoVector(son1p);

Func0(Fu1);

//Distance for 1st son

L1:=Rast(Fu1);

//Chromosome with biggest distance to Pareto set

Lmax:=Lh[0];

imax:=0;

for i:=1 to HH-1 do

if Lh[i]>Lmax then

begin

Lmax:=Lh[i];

imax:=i;

end;

if L1<Lmax then

//if distance to Pareto set 1st son is less than biggest distance

//...in population then make substitution

begin

for i:=0 to lchr-1 do

PopChrStr[imax,i]:=son1s[i];

for i:=0 to p*(c+d)-1 do

PopChrPar[imax,i]:=son1p[i];

for i:=0 to nfu-1 do

Fuh[imax,i]:=Fu1[i];

end;

//calculating all distances for population

for i:=0 to HH-1 do

Lh[i]:=Rast(Fuh[i]);

//mutation for 2nd son

if random<pmut then

begin

son2p[random(p*(c+d))]:=random(2);

NOP.GenVar(son2s[random(lchr)]);

end;

//functional for 2nd son

NOP.SetPsi(NOP.Psi0);

for j:=0 to lchr-1 do

NOP.Variations(son2s[j]);

GreytoVector(son2p);

Func0(Fu2);

//Distance for 2nd son

L2:=Rast(Fu2);

//Chromosome with biggest distance to Pareto set

Lmax:=Lh[0];

imax:=0;

for i:=1 to HH-1 do

if Lh[i]>Lmax then

begin

Lmax:=Lh[i];

imax:=i;

end;

if L1<Lmax then

//if distance to Pareto set 2nd son is less than biggest distance

//...in population then make substitution

begin

for i:=0 to lchr-1 do

PopChrStr[imax,i]:=son2s[i];

for i:=0 to p*(c+d)-1 do

PopChrPar[imax,i]:=son2p[i];

for i:=0 to nfu-1 do

Fuh[imax,i]:=Fu2[i];

end;

//calculating all distances for population

for i:=0 to HH-1 do

Lh[i]:=Rast(Fuh[i]);

//mutation for 3rd son

if random<pmut then

begin

son3p[random(p*(c+d))]:=random(2);

NOP.GenVar(son3s[random(lchr)]);

end;

//functional for 3rd son

NOP.SetPsi(NOP.Psi0);

for j:=0 to lchr-1 do

NOP.Variations(son1s[j]);

GreytoVector(son1p);

Func0(Fu3);

//Distance for 3rd son

L3:=Rast(Fu3);

//Chromosome with biggest distance to Pareto set

Lmax:=Lh[0];

imax:=0;

for i:=1 to HH-1 do

if Lh[i]>Lmax then

begin

Lmax:=Lh[i];

imax:=i;

end;

if L3<Lmax then

//if distance to Pareto set 3rd son is less than biggest distance

//...in population then make substitution

begin

for i:=0 to lchr-1 do

PopChrStr[imax,i]:=son3s[i];

for i:=0 to p*(c+d)-1 do

PopChrPar[imax,i]:=son3p[i];

for i:=0 to nfu-1 do

Fuh[imax,i]:=Fu3[i];

end;

//calculating all distances for population

for i:=0 to HH-1 do

Lh[i]:=Rast(Fuh[i]);

//mutation for 4th son

if random<pmut then

begin

son4p[random(p*(c+d))]:=random(2);

NOP.GenVar(son4s[random(lchr)]);

end;

//functional for 4th son

NOP.SetPsi(NOP.Psi0);

for j:=0 to lchr-1 do

NOP.Variations(son4s[j]);

GreytoVector(son4p);

Func0(Fu4);

//Distance for 4th son

L4:=Rast(Fu4);

//Chromosome with biggest distance to Pareto set

Lmax:=Lh[0];

imax:=0;

for i:=1 to HH-1 do

if Lh[i]>Lmax then

begin

Lmax:=Lh[i];

imax:=i;

end;

if L4<Lmax then

//if distance to Pareto set 4th son is less than biggest distance

//...in population then make substitution

begin

for i:=0 to lchr-1 do

PopChrStr[imax,i]:=son4s[i];

for i:=0 to p*(c+d)-1 do

PopChrPar[imax,i]:=son4p[i];

for i:=0 to nfu-1 do

Fuh[imax,i]:=Fu4[i];

end;

//calculating all distances for population

for i:=0 to HH-1 do

Lh[i]:=Rast(Fuh[i]);

end;

rt:=rt+1;

//End of cycle for crossoving

until rt>RR;

// generating new chromosomes

// Checking Epoch

pt:=pt+1;

//if epoch is over then changing basic

if pt mod Epo=0 then

begin

//... на наиболее близкую хромосому к утопической

// хромосоме в пространстве нормированных криетриев

for i:=0 to nfu-1 do

begin

Fumax:=Fuh[0,i];

Fumin:=Fuh[0,i];

// ищем максимальное и минимальное значения по каждому функционалу

for k:=0 to HH-1 do

if Fuh[k,i]>Fumax then

Fumax:=Fuh[k,i]

else

if Fuh[k,i]< Fumin then

Fumin:=Fuh[k,i];

// нормируем критерии, поделив каждое значение на разность между

// максимумом и минимумом

if Fumax<>Fumin then

for k:=0 to HH-1 do

FuhNorm[k,i]:=Fuh[k,i]/(Fumax-Fumin);

end;

// находим хромосому с наименьшей величиной нормы нормированных критериев

k:=0;

su:=0;

// for i:=0 to nfu-1 do

// su:=su+sqr(FuhNorm[0,i]);

//

// su:=sqrt(su);

su:=FuhNorm[0,1];

for i:=1 to HH-1 do

begin

// su1:=0;

// for j:=0 to nfu-1 do

// su1:=su1+sqr(FuhNorm[i,j]);

// su1:=sqrt(su1);

su1:=FuhNorm[i,1];

if su1<su then

begin

su:=su1;

k:=i;

end;

end;

// заменяем базис

// строим матрицу для найденной хромосомы

NOP.SetPsi(NOP.Psi0);

for j:=0 to lchr-1 do

NOP.Variations(PopChrStr[k,j]);

// меняем базисную матрицу на новую

NOP.SetPsiBas(NOP.Psi);

//генерируем тождественную хромосому

for i:=0 to lchr-1 do

for j:=0 to 3 do

PopChrStr[0,i,j]:=0;

for i:=0 to p*(c+d)-1 do

PopChrPar[0,i]:=PopChrPar[k,i];

//вычисляем все фунционалы для всей популяции

for i:=0 to HH-1 do

begin

NOP.SetPsi(NOP.Psi0);

for j:=0 to lchr-1 do

NOP.Variations(PopChrStr[i,j]);

GreytoVector(PopChrPar[i]);

Func0(Fuh[i]);

end;

// формируем элиту

for i:=0 to kel-1 do

begin

j:=random(HH-1)+1;

GreytoVector(PopChrPar[j]);

ImproveChrom(q,PopChrStr[j]);

end;

//вычисляем новые расстояния

for i:=0 to HH-1 do

Lh[i]:=Rast(Fuh[i]);

end;

//конец цикла поколений

EndGeneration;

// form1.ProgressBar1.StepIt;

// Form1.Refresh;

until pt>PP;

ChoosePareto;

//строим множество Парето

End;

Procedure TGANOP.GenAlgorithm1;

// Генетический алгоритм для поиска оптимальных значений параметров

var

i,j,pt,rt,k1,k2,lmax,imax,ks2:integer;

ksi:real;

FuhNorm:TArrArrreal;

Begin

setlength(FuhNorm,HH,nfu);

//генерация популяции

NOP.SetPsiBas(NOP.Psi);

VectortoGrey(PopChrPar[0]);

for i:=1 to HH-1 do

begin

for j:=0 to p*(c+d)-1 do

PopChrPar[i,j]:=random(2);

end;

//вычисление значений функционалов для каждой хромосомы

for i:=0 to HH-1 do

begin

GreytoVector(PopChrPar[i]);

Func0(Fuh[i]);

end;

//вычисление расстояний до множества Парето

for i:=0 to HH-1 do

Lh[i]:=Rast(Fuh[i]);

//начало цикла поколений

pt:=1; // первое текущее поколение

repeat

//начало цикла скрещивания

rt:=1;//первая пара скрещивания

repeat

//отбор двух родителей

k1:=random(HH);

k2:=random(HH);

ksi:=random;

if (ksi<(1+alfa*Lh[k1])/(1+Lh[k1])) or