3.5.2. Модуль «Geneticalg»

Модуль «GeneticAlg» описує та реалізує функціональність генетичного алгоритму. Він містить 1 функцію та 6 процедур, тексти основних з яких наведено нижче.

//Формуємо початкову популяцію

procedure TGeneticForm.FormShow(Sender: TObject);

var

i,j, kt : Integer;

temp_s: string;

begin

epoxa:=1;

Edit20.Text:='';

StringGrid1.Cells[0,0]:='Популяція';

StringGrid1.Cells[1,0]:='Нащадки';

StringGrid1.Cells[2,0]:='Значення фітнес-функції';

StringGrid1.Cells[3,0]:='Вибір батьків';

Val(BildSxema.Edit13.Text,kt,code);

If GenOption.RadioButton1.Checked then begin

i:=1;

While BildSxema.StringGrid2.Cells[0,i]<>'' do begin

temp_s:='';

For j:=1 to kt do temp_s:=temp_s+BildSxema.StringGrid2.Cells[j-1,i];

StringGrid1.Cells[0,i]:=temp_s;

Inc(i);

end;

kt_pop:=i-1;

end;

If GenOption.RadioButton10.Checked then begin

Randomize;

kt_pop:=Round(exp(kt*ln(2)));

For j:=1 to kt_pop do begin

temp_s:='';

For i:=1 to kt do begin

temp_s:=temp_s+IntToStr(Random(2));

StringGrid1.Cells[0,j]:=temp_s;

end;

end;

end;

If GenOption.RadioButton11.Checked then begin

Randomize;

kt_pop:=Round(exp(kt*ln(2)))-2;

For j:=1 to kt_pop do begin

temp_s:='00';

For i:=1 to kt do begin

temp_s:=temp_s+IntToStr(Random(2));

StringGrid1.Cells[0,j]:=temp_s;

end;

end;

end;

end;

//Реалізуємо операцію схрещування

procedure TGeneticForm.N2Click(Sender: TObject);

Var

a, b, i, k, d, d1 : integer;

as1, as2, bs1, bs2, as3, bs3 : string;

begin

for i:=1 to 1024 do begin

GeneticForm.StringGrid1.Cells[1,i]:='';

GeneticForm.StringGrid1.Cells[2,i]:='';

GeneticForm.StringGrid1.Cells[3,i]:='';

end;

//Схрещування навпіл

If GenOption.RadioButton14.Checked then begin

Val(BildSxema.Edit13.Text,d,code);

randomize;

k:=1;

For i:=1 to Round(kt_pop/2)+1 do begin

a:=0; b:=0;

While a=0 do a:=Round(Random(kt_pop));

While b=0 do b:=Round(Random(kt_pop));

as1:=StringGrid1.Cells[0,a];

bs1:=StringGrid1.Cells[0,b];

as2:=copy(as1,Round(length(as1)/2),Round(d/2));

as1:=copy(as1,1,Round(d/2));

bs2:=copy(bs1,Round(length(bs1)/2),Round(d/2));

bs1:=copy(bs1,1,Round(d/2));

StringGrid1.Cells[1,k]:=as1+bs2;

inc(k);

StringGrid1.Cells[1,k]:=bs1+as2;

Inc(k);

if k >= kt_pop then exit;

end;

end;

//Одноточковий кросовер

If GenOption.RadioButton2.Checked then begin

Val(GenOption.Edit6.Text,d,code);

k:=1;

For i:=1 to Round(kt_pop/2)+1 do begin

a:=0; b:=0;

While a=0 do a:=Round(Random(kt_pop));

While b=0 do b:=Round(Random(kt_pop));

as1:=StringGrid1.Cells[0,a];

bs1:=StringGrid1.Cells[0,b];

as2:=copy(as1,d+1,Length(as1)-d);

as1:=copy(as1,1,d);

bs2:=copy(bs1,d+1,Length(bs1)-d);

bs1:=copy(bs1,1,d);

StringGrid1.Cells[1,k]:=as1+bs2;

inc(k);

StringGrid1.Cells[1,k]:=bs1+as2;

Inc(k);

if k >= kt_pop then exit;

end;

end;

//Двоточковий кросовер

If GenOption.RadioButton4.Checked then begin

Val(GenOption.Edit7.Text,d,code);

Val(GenOption.Edit8.Text,d1,code);

k:=1;

For i:=1 to Round(kt_pop/2)+1 do begin

a:=0; b:=0;

While a=0 do a:=Round(Random(kt_pop));

While b=0 do b:=Round(Random(kt_pop));

as1:=StringGrid1.Cells[0,a];

bs1:=StringGrid1.Cells[0,b];

as3:=copy(as1,d1+1,Length(as1)-d1);

as2:=copy(as1,d+1,d1-d);

as1:=copy(as1,1,d);

bs3:=copy(bs1,d1+1,Length(bs1)-d1);

bs2:=copy(bs1,d+1,d1-d);

bs1:=copy(bs1,1,d);

StringGrid1.Cells[1,k]:=as1+bs2+as3;

inc(k);

StringGrid1.Cells[1,k]:=bs1+as2+bs3;

Inc(k);

if k >= kt_pop then exit;

end;

end;

end;

//Виконання оператору мутації

procedure TGeneticForm.N3Click(Sender: TObject);

Var

a, b, i, pp, a1, b1 :integer;

as1 : string;

begin

Val(BildSxema.Edit13.Text,pp,code);

//Мутація 1-го гена

for i := 1 to kt_pop-1 do

StringGrid1.Cells[2,i]:='';

randomize;

for i:= 1 to kt_pop-1 do

begin

if Round(Random(5))=4 then begin

a:=Round(Random(2));

b:=Round(Random(pp));

if b=0 then continue;

as1:=StringGrid1.Cells[1,i];

if ((a= 0) and (as1[b]='1')) then as1[b]:='0'

else as1[b]:='1';

if ((a= 1) and (as1[b]='1')) then as1[b]:='0'

else as1[b]:='1';

StringGrid1.Cells[1,i]:=as1;

end;

end;

for i:=1 to 1024 do begin

GeneticForm.StringGrid1.Cells[2,i]:='';

GeneticForm.StringGrid1.Cells[3,i]:='';

end;

//Мутація 2-х генів

for i := 1 to kt_pop-1 do

StringGrid1.Cells[2,i]:='';

randomize;

for i:= 1 to kt_pop-1 do

begin

if Round(Random(5))=4 then begin

a:=Round(Random(2));

a1:=Round(Random(2));

b:=Round(Random(pp));

b1:=Round(Random(pp));

if b=0 then continue;

as1:=StringGrid1.Cells[1,i];

if ((a= 0) and (as1[b]='1')) then as1[b]:='0'

else as1[b]:='1';

if ((a= 1) and (as1[b]='1')) then as1[b]:='0'

else as1[b]:='1';

if ((a1= 0) and (as1[b1]='1')) then as1[b1]:='0'

else as1[b]:='1';

if ((a1= 1) and (as1[b1]='1')) then as1[b1]:='0'

else as1[b]:='1';

StringGrid1.Cells[1,i]:=as1;

end;

end;

for i:=1 to 1024 do begin

GeneticForm.StringGrid1.Cells[2,i]:='';

GeneticForm.StringGrid1.Cells[3,i]:='';

end;

end;

procedure TGeneticForm.N4Click(Sender: TObject);

label

l;

var

I, j, n, zn, kk, vybir: Integer;

a, b : integer;

tt : string;

temp_population: array [1..1024] of string;

finish: boolean;

begin

Inc(epoxa); //Лічильник епох

//Опрацювання схеми

i:=1;

n:=length(StringGrid1.Cells[1,i]);

While GeneticForm.StringGrid1.Cells[1,i]<>'' do begin

znchfunc:=0;

tt:=StringGrid1.Cells[1,i];

For j:=1 to n do

BildSxema.StringGrid1.Cells[1,j+1]:=copy(GeneticForm.StringGrid1.Cells[1,i],j,1);

BildSxema.SpeedButton1Click(BildSxema);

BildSxema.N10Click(BildSxema);

kk:=ssearch(tt);

For j:=0 to Cxema.ChipsCount-1 do begin

zn:= Cxema.Elements[j].RightLegs[0].Value ;

If BildSxema.StringGrid2.Cells[n+j,kk]<>IntToStr(zn) then Inc(znchfunc);

end;

StringGrid1.Cells[2,i]:=IntToStr(znchfunc);

Inc(i);

end;

kt_pop:=i-1;

for i:=1 to 1024 do

GeneticForm.StringGrid1.Cells[0,i]:='';

//Пропорційний відбір (метод рулетки)

If GenOption.RadioButton8.Checked then begin

Randomize;

For i:=1 to kt_pop do begin

while vybir=0 do vybir:=Random(kt_pop);

GeneticForm.StringGrid1.Cells[3,vybir]:='обрано';

GeneticForm.StringGrid1.Cells[0,i]:=GeneticForm.StringGrid1.Cells[1,vybir];

end;

end;

//Відсікання

If GenOption.RadioButton3.Checked then begin

Val(GenOption.Edit2.Text,vybir,code);

vybir:=kt_pop-Round(vybir/100);

For i:=1 to vybir do begin

GeneticForm.StringGrid1.Cells[3,i]:='обрано';

GeneticForm.StringGrid1.Cells[0,i]:=GeneticForm.StringGrid1.Cells[1,i];

end;

end;

//Турнірний відбір

If GenOption.RadioButton3.Checked then begin

n:=1;

for I := 1 to kt_pop do

if GeneticForm.StringGrid1.Cells[2,i]=BildSxema.Label17.Caption then begin

GeneticForm.StringGrid1.Cells[3,i]:='обрано';

GeneticForm.StringGrid1.Cells[0,n]:=GeneticForm.StringGrid1.Cells[1,i];

Inc(n);

end;

end;

Val(GenOption.Edit4.Text,vybir,code);

if (kt_pop=4) or (epoxa=vybir) then begin

Edit20.Text:=StringGrid1.Cells[1,1];

ShowMessage(' Тестову послідовність відшукано !');

For j:=1 to n do

BildSxema.StringGrid1.Cells[1,j-1]:=copy(GeneticForm.StringGrid1.Cells[1,i],j,1);

BildSxema.SpeedButton1Click(BildSxema);

BildSxema.N10Click(BildSxema);

end;

end;