Генетические алгоритмы (стр. 2 )

Label9: TLabel;

Label10: TLabel;

stxTarget: TStaticText;

stxX: TStaticText;

stxY: TStaticText;

Label11: TLabel;

Label12: TLabel;

edtMaxCount: TEdit;

Label13: TLabel;

btnStop: TButton;

procedure FormCreate(Sender: TObject);

function GA1GetSutability(

Chromosome: TChromosome): Double;

procedure btnStartClick(Sender: TObject);

procedure cbxFunctionChange(Sender: TObject);

procedure btnStopClick(Sender: TObject);

private

{ Private declarations }

fTarget : TTargetFunction;

fImage : TBitmap;

public

{ Public declarations }

StopFlag : boolean;

procedure CreateImage;

property Target : TTargetFunction read fTarget write fTarget;

procedure OneEpoch;

end;

var

frmMain: TfrmMain;

xBmp : array [0..99,0..99] of double;

implementation

var

fMinX, fMaxX, fMinY, fMaxY : double;

{$R *.DFM}

function De_Jong_2(X1,X2:double):double;

var

xF1,xF2 : double;

begin

fMinX := -1.28;

fMinY := -1.28;

fMaxX := 1.28;

fMaxY := 1.28;

// денормализуем параметры в нужный интервал

X1 := (X1*1.28*2)-1.28;

X2 := (X2*1.28*2)-1.28;

xF1 := sqr(X1-X2);

xF2 := sqr(1-X1);

Result := 100.0/(100.0*xF1+xF2+1.0);

end;

function De_Jong_5(X1,X2:double):double;

var

J : integer;

xS1,xS2 : double;

begin

fMinX := -65.536;

fMinY := -65.536;

fMaxX := 65.536;

fMaxY := 65.536;

X1 := (X1*65.536*2)-65.536;

X2 := (X2*65.536*2)-65.536;

xS1 := 0;

for J := 1 to 25 do

begin

xS2 := power(X1 - 16*((J mod 5)-2),6)+ power(X2 - 16*((J div 5)-2),6);

xS1 := xS1 + 1/(J+xS2);

end;

Result := xS1 + 0.002;

end;

function Rasstrigin(X1,X2:double):double;

begin

fMinX := -5.12;

fMinY := -5.12;

fMaxX := 5.12;

fMaxY := 5.12;

X1 := (X1*5.12*2)-5.12;

X2 := (X2*5.12*2)-5.12;

Result := 20 + sqr(X1) + sqr(X2) - 10*cos(2*Pi*X1)-10*cos(2*Pi*X2);

end;

function Griewank(X1,X2:double):double;

begin

fMinX := -20;

fMinY := -20;

fMaxX := 20;

fMaxY := 20;

X1 := (X1*20*2)-20;

X2 := (X2*20*2)-20;

Result := 1/((sqr(X1)+sqr(X2))/200 - cos(X1)*cos(X2/sqrt(2))+2);

end;

procedure TfrmMain. CreateImage;

var

I, J : integer;

xMax, xMin : double;

xR, xG, xB : integer;

xVal : double;

begin

// рассчитываем образ на экране

for I:=0 to 99 do

for J:=0 to 99 do

begin

xBmp[I, J] := Target(I/100,J/100);

if (I=0) and (J=0) then

begin

xMax := xBmp[I, J];

xMin := xBmp[I, J];

end;

if xBmp[I, J] < xMin then

xMin := xBmp[I, J];

if xBmp[I, J] > xMax then

xMax := xBmp[I, J];

if xMax>1000 then

begin

xMax := xMax+1;

end;

end;

stxTarget. Caption := FloatToStr(xMax);

// а теперь рисуем картинку

for I := 0 to 99 do

for J := 0 to 99 do

begin

xB := 255-Round(255*(xBmp[I, J]-xMin)/(xMax-xMin));

xR := Round(255*(xBmp[I, J]-xMin)/(xMax-xMin));

if xB<128 then

xG := xB

else

xG := xB-128;

fImage. Canvas. Pixels[I, J] := RGB(xR, xG, xB);

end;

imgFunction. Picture. Assign(fImage);

end;

procedure TfrmMain. FormCreate(Sender: TObject);

begin

DecimalSeparator := '.';

// инициализируем интерфейс

cbxGeneDegree. ItemIndex := 1;

cbxOptimizeMethod. ItemIndex := 1;

cbxFunction. ItemIndex := 0;

// инициализируем внутренние переменные

fImage := TBitmap. Create;

fImage. Width := 100;

fImage. Height := 100;

frmMain. Target := De_Jong_5;

// рисуем первую картинку

CreateImage;

end;

function TfrmMain. GA1GetSutability( Chromosome: TChromosome): Double;

var

X1,X2 : double;

begin

// рассчитываем приспособленность

X2 := Chromosome. GeneAsFloat[0];

X1 := Chromosome. GeneAsFloat[1];

Result := Target(X1,X2);

// рисуем хромосому

imgFunction. Canvas. Pixels[round(X1*100),round(X2*100)] := RGB(255,255,255);

end;

procedure TfrmMain. btnStartClick(Sender: TObject);

var

I : integer;

xCnt : integer;

xOldS : double;

xMaxCnt : integer;

begin

// инициализируем все переменные

xMaxCnt := StrToInt(edtMaxCount. Text);

GA1.OptimizeMethod := TOptimizeMethod(cbxOptimizeMethod. ItemIndex);

GA1.UseElita := chbUseElitism. Checked;

GA1.Inversion_P := StrToFloat(edtInversionP. Text);

GA1.Mutation_P := StrToFloat(edtMutationP. Text);

GA1.Crossover_P := StrToFloat(edtCrossoverP. Text);

GA1.GeneDegree := TGeneDegree(cbxGeneDegree. ItemIndex);

GA1.ChromosomeCount := StrToInt(edtChromosomeCount. Text);

GA1.Init;

xOldS := 0;

xCnt := 0;

btnStart. Enabled := False;

btnStop. Enabled := True;

StopFlag := False;

for I := 0 to 1000000 do

begin

if xCnt >= xMaxCnt then

begin

Application. MessageBox(PChar(Format('Обучение остановлено'#10#13+

'Приспособленность не менялась в течении %d эпох',[xMaxCnt])),

'Завершение обучения',0);

break; end;

if StopFlag then break;

OneEpoch;

if (abs(xOldS - GA1.BestChromosome. Suitability) < 1.0E-8) then

inc(xCnt)

else

xCnt := 0;

xOldS := GA1.BestChromosome. Suitability;

stxTarget. Caption := FloatToStr(GA1.BestChromosome. Suitability);

stxX. Caption := FloatToStr(GA1.BestChromosome. GeneAsFloat[0]*(fMaxX-fMinX)+fMinX);

stxY. Caption := FloatToStr(GA1.BestChromosome. GeneAsFloat[1]*(fMaxY-fMinY)+fMinY);

Application. ProcessMessages;

end;

btnStart. Enabled := True;

btnStop. Enabled := False;

end;

procedure TfrmMain. OneEpoch;

begin

imgFunction. Picture. Assign(fImage);

GA1.OneEpoch;

end;

procedure TfrmMain. cbxFunctionChange(Sender: TObject);

begin

case cbxFunction. ItemIndex of

// 0: Target := De_Jong_2;

0: Target := De_Jong_5;

1: Target := Rasstrigin;

2: Target := Griewank;

end;

CreateImage;

end;

procedure TfrmMain. btnStopClick(Sender: TObject);

begin

StopFlag := True;

end;

end.

unit genetic;

interface

uses Classes,{NewBitMath,}SysUtils, Math;

const

// таблицы преобразования для кода Грея

GrayToDec : array[0..15] of byte = (0,1,3,2,7,6,4,5,15,14,12,13,8,9,11,10);

DecToGray : array[0..15] of byte = (0,1,3,2,6,7,5,4,12,13,15,14,10,11,9,8);

// параметры алгоритма по умолчанию

DEFAULT_GENE_DEGREE = 32;

DEFAULT_GENE_COUNT = 2;

MAX_GENE_COUNT = 1024;

MAX_CHROMOSOME_PER_POPULATION = 10000;

CROSSOVER_PROBABILITY = 0.98;

MUTATION_PROBABILITY = 0.1;

SHIFT_PROBABILITY = 0.2;

INVERSION_PROBABILITY = 0.1;

type

TGene = record

BegPos : integer; // положение первого элемента гена в хромосоме

Degree : integer; // длинна гена

end;

TGeneDegree = (Short_8,Midle_16,Long_32);

TOptimizeMethod = (omMinimize, omMaximize);

// основной класс - хромосома

TChromosome = class(TBits{Vector})

private

fDegree : integer; // длинна гена

fGeneCount : integer; //количество генов

fGene : array of TGene; //Массив описателей генов

procedure SetGeneCount(Value : integer);

function GetGeneSize:integer;

procedure SetGeneSize(Value:integer);

function GetGene(Index:integer):LongWord;

procedure SetGene(Index:integer;Value:LongWord);

function GetGeneAsInteger(Index:integer):LongInt;

procedure SetGeneAsInteger(Index:integer;Value:LongInt);