информатика, курсовой проект / GEN

program gen_alg;
uses crt;

const maxpop = 80;
maxstring = 30;
dim = 2;

type allele = boolean;
chromosome = array [1..maxstring*dim] of allele;
fenotype=array[1..dim] of real;

individual=record
chrome: chromosome;
x: fenotype;
fitness: real;
end;

population = array [1..maxpop] of individual;

const xmax: fenotype=(5.12,5.12);
xmin: fenotype = (-5.12,-5.12);

var oldpop, newpop, intpop: population;
popsize,lchrom,ncross,nmutation,maxgen,gen: integer;
pcross,pmutation: real;
min,max,avg,sumfitness:real;

function objfunc(x:fenotype): real;
begin
objfunc:=sqr(x[1])+sqr(x[2]);
end;

function flip(probability:real):boolean;
begin
flip:=(probability=1.0) or (random<=probability);
end;

procedure decode(chrom: chromosome; lbits: integer; var x: fenotype);
var i,j: integer;
f, accum, powerof2: real;
begin
for i:=1 to dim do
begin
accum:=0.0;
powerof2:=1;
f:=1;
for j:=1+lbits*(i-1) to lbits*i do
begin
if chrom[j] then
accum:=accum+powerof2;
powerof2:=powerof2*2;
f:=f*2;
end;
x[i]:=xmin[i]+(xmax[i]-xmin[i])*accum/(f-1);
end;
end;

procedure initpop;
var j,j1: integer;
begin
for j:=1 to popsize do
with oldpop[j] do
begin
for j1:=1 to lchrom*dim do
chrome[j1]:=flip(0.5);
decode(chrome,lchrom,x);
fitness:=objfunc(x);
end;
end;


procedure select;
var ipick: integer;

procedure shuffle(var pop: population);
var i,j: integer;
ind0: individual;

begin
for i:=popsize downto 2 do
begin
j:=random(i-1)+1;
ind0:=pop[i];
pop[i]:=pop[j];
pop[j]:=ind0;
end;
end;

function select1: integer;
var j1,j2,m: integer;
begin
if ipick>popsize then
begin
shuffle(oldpop);
ipick:=1;
end;
j1:=ipick;
j2:=ipick+1;
if (oldpop[j2].fitness<oldpop[j1].fitness) then
m:=j2
else
m:=j1;
ipick:=ipick+2;
select1:=m;
end;

var j: integer;

begin
ipick:=1;
for j:=1 to popsize do
intpop[j]:=oldpop[select1];
oldpop:=intpop;
end;

procedure mutation(var val:chromosome; const flchrom: integer;
pmutation: real; var nmutation:integer);

var mutate: boolean;
point1,point2:integer;
buf: allele;
begin
mutate:=flip(pmutation);
if mutate then
begin
inc(nmutation);
point1:=random(flchrom-1)+1;
point2:=random(flchrom-1)+1;
buf:=val[point1];
val[point1]:=val[point2];
val[point2]:=buf;
end;
end;

procedure crossover(var parent1, parent2, child1, child2: chromosome;
flchrom:integer; var ncross,nmutation:integer;
var pcross,pmutation: real);
var j: integer;
point1,point2,buf: integer;
begin
if flip(pcross) then
begin
inc(ncross);
point1:=random(flchrom-1)+1;
point2:=random(flchrom-1)+1;

if point1>point2 then
begin
buf:=point1;
point1:=point2;
point2:=buf;
end;
end
else
begin
point1:=flchrom;
point2:=flchrom;
end;

for j:=1 to point1 do
begin
child1[j]:=parent1[j];
child2[j]:=parent2[j];
end;

for j:=point1+1 to point2 do
begin
child1[j]:=parent2[j];
child2[j]:=parent1[j];
end;

for j:=point2+1 to flchrom do
begin
child1[j]:=parent1[j];
child2[j]:=parent2[j];
end;

mutation(child1,flchrom,pmutation,nmutation);
mutation(child1,flchrom,pmutation,nmutation);
end;

procedure generation;
var j, mate1, mate2,jcross: integer;

begin
select;
j:=1;
repeat;
mate1:=j;
mate2:=j+1;
crossover(oldpop[mate1].chrome, oldpop[mate2].chrome,
newpop[j].chrome, newpop[j+1].chrome,
lchrom*dim, ncross, nmutation, pcross, pmutation);
with newpop[j] do
begin
decode(chrome,lchrom,x);
fitness:=objfunc(x);
end;
j:=j+1;
until j>popsize;
end;

procedure statistics(popsize: integer; var max,avg,min,sumfitness: real;
var pop: population; var xmin,ymin: real);
var j: integer;

begin
sumfitness:=pop[1].fitness;
min:=pop[1].fitness;
max:=pop[1].fitness;
xmin:=pop[1].x[1];
ymin:=pop[1].x[2];
for j:=2 to popsize do
with pop[j] do
begin
sumfitness:=sumfitness+fitness;
if fitness>max then
max:=fitness;
if fitness<min then
begin
min:=fitness;
xmin:=pop[j].x[1];
ymin:=pop[j].x[2];
end;
end;
avg:=sumfitness/popsize;
end;

var min_,avg_,xmin_,ymin_: real;
i,cnt: integer;

begin
clrscr;
cnt:=20;
min_:=MaxInt;
avg_:=0;
for i:=1 to cnt do
begin
popsize:=8;
lchrom:=20;
maxgen:=80;
pmutation:=0.01;
pcross:=0.8;
randomize;
nmutation:=0;
ncross:=0;
initpop;
statistics(popsize,max,avg,min,sumfitness,oldpop,xmin_,ymin_);
gen:=0;
repeat
gen:=gen+1;
generation;
statistics(popsize,max,avg,min,sumfitness,newpop,xmin_,ymin_);
oldpop:=newpop;
until (gen>=maxgen);
writeln('min=',min:10:8,' x=',xmin_:9:7,' y=',ymin_:9:7);
avg_:=avg_+min;
if min_>min then
min_:=min;
end;
avg_:=avg_/cnt;
writeln('global min=',min_:10:8);
writeln('global avg=',avg_:10:8);
readln;
end.