pos:position;
begin
j:=0;
for i:=1 to pop_size do
begin
randomize;
r:=random;
if r<=0.3 then
begin
inc(j);
parent[j]:=hr[i];
pos[j]:=i;
end;
end;
if ((j mod 2)=1)then j:=j-1;
i:=1;
While i<j do
begin
randomize;
c:=random;
for k:=1 to 5 do
begin
hr[pos[i],k]:=round(c*parent[i,k]+(1-c)*parent[i+1,k]);
hr[pos[i+1],k]:=round((1-c)*parent[i,k]+c*parent[i+1,k]);
end;
i:=i+2;
end;
end;
procedure mut(var hr:hromo);
var i,j,k,l,M:integer;
r:real;
parent:hromo;
pos:position;
c:koef;
begin
j:=0;
for i:=1 to pop_size do
begin
randomize;
r:=random;
if r<=0.2 then
begin
inc(j);
parent[j]:=hr[i];
pos[j]:=i;
end;
end;
i:=1;
l:=0;
While i<=j do
begin
inc(l);
for k:=1 to 5 do
begin
randomize;
c[k]:=random*power(-1,random(2));
end;
randomize;
M:=random(10);
for k:=1 to 5 do parent[i,k]:=round(parent[i,k]+M*c[k]);
if odz(parent[i]) then
begin
hr[pos[i]]:=parent[i];
inc(i);
l:=0;
end
else
begin
M:=random(M);
if l>=10 then inc(i);
end;
end;
end;
procedure cel_f(hr:hromo; var zn:ves);
var i,j:integer;
begin
for i:=1 to 10 do
begin
stat_res(hr[i],dd);
for j:=1 to 3 do
if d[j]>dd[j] then zn[i,j]:=d[j]-dd[j]
else zn[i,j]:=0;
end;
end;
procedure sort(var hr:hromo);
var i,j:integer;
e1:koef;
begin
cel_f(hr,zn);
for i:=1 to pop_size-1 do
for j:=i+1 to pop_size do
if zn[i,1]>zn[j,1] then
begin
e1:=hr[i];
hr[i]:=hr[j];
hr[j]:=e1;
e1:=zn[i];
zn[i]:=zn[j];
zn[j]:=e1;
end;
for i:=1 to pop_size-1 do
for j:=i+1 to pop_size do
if zn[i,1]=zn[j,1] then
if zn[i,2]>zn[j,2] then
begin
e1:=hr[i];
hr[i]:=hr[j];
hr[j]:=e1;
e1:=zn[i];
zn[i]:=zn[j];
zn[j]:=e1;
end;
for i:=1 to pop_size-1 do
for j:=i+1 to pop_size do
if zn[i,2]=zn[j,2] then
if zn[i,3]>zn[j,3] then
begin
e1:=hr[i];
hr[i]:=hr[j];
hr[j]:=e1;
e1:=zn[i];
zn[i]:=zn[j];
zn[j]:=e1;
end;
end;
procedure eval(var ev:koef);
var i:integer;
a:real;
begin
a:=0.05;
for i:=1 to pop_size do ev[i]:=power(a*(1-a), i-1);
end;
procedure selection(var hr:hromo);
var q,ev:koef;
i,j:integer;
r:real;
hr1:hromo;
begin
sort(hr);
eval(ev);
for i:=1 to pop_size do
begin
q[i]:=0;
for j:=1 to i do q[i]:=q[i]+ev[j];
end;
for j:=1 to pop_size do
begin
randomize;
r:=random*q[pop_size];
i:=1;
while q[i]<=r do inc(i);
hr1[j]:=hr[i];
end;
for i:=1 to pop_size do hr[i]:=hr1[i];
end;
procedure res(hr:hromo);
var i:integer;
summ1,summ2:real;
begin
for i:=1 to 5 do
write(hr[1,i]:4:2,' ');
writeln;
stat_res(hr[1],dd);
for i:=1 to 3 do
write(dd[i]:5:3,' ');
summ1:=0;
for i:=1 to 5 do
summ1:=summ1+cost[i]*hr[1,i];
summ2:=0;
for i:=1 to 5 do
summ2:=summ2+sq[i]*hr[1,i];
writeln('cost = ',summ1);
writeln('square = ',summ2);
end;
procedure gib;
var hr:hromo;
i:integer;
begin
init(hr);
for i:=1 to gen_alg do
begin
writeln(i,' step');
cross(hr);
mut(hr);
selection(hr);
end;
res(hr);
end;
begin
uslovie;
gib;
Readln;
end.