II8
.odtЕвдокимов Никита
IT-13-1
Вариант 5
Лабораторная работа 8
РЕШЕНИЕ ЗАДАЧИ ОПТИМИЗАЦИИ ГЕНЕТИЧЕСКИМ АЛГОРИТМОМ
Цель работы: ознакомиться с особенностями генетического алгоритма. Изучить генетические операторы. Выработать навыки решения задачи оптимизации с использованием данного алгоритма.
Задания для выполнения лабораторной работы
Выполните реализацию генетического алгоритма для задачи оптимизации.
Протестировать генетический алгоритм.
Номер варианта |
Функция f(x1,x2) |
X0 |
5 |
-12x1+3x+6x2+3x+4 |
(-2,3) |
Листинг программы:
unit fmMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, genetic,math;
type
TTargetFunction = function(X1,X2 : double):double;// of object;
TfrmMain = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
GroupBox1: TGroupBox;
Label1: TLabel;
edtChromosomeCount: TEdit;
Label2: TLabel;
cbxGeneDegree: TComboBox;
Label3: TLabel;
edtCrossoverP: TEdit;
Label4: TLabel;
edtMutationP: TEdit;
Label5: TLabel;
edtInversionP: TEdit;
Label6: TLabel;
Label7: TLabel;
cbxOptimizeMethod: TComboBox;
Label8: TLabel;
cbxFunction: TComboBox;
imgFunction: TImage;
btnStart: TButton;
chbUseElitism: TCheckBox;
GroupBox2: TGroupBox;
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 }
GA1: TGeneticAlgorithm;
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 := -2*x1+0.2*sqr(x1)-3*x2+0.2*sqr(x2)+4;
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
GA1 := TGeneticAlgorithm.Create(self);
GA1.OnGetSutability := GA1GetSutability;
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.GeneCount := 2;
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_5;
1: Target := Rasstrigin;
2: Target := Griewank;
end;
CreateImage;
end;
procedure TfrmMain.btnStopClick(Sender: TObject);
begin
StopFlag := True;
end;
end.
Результаты работы:
Вывод: в ходе выполнения лабораторной работы были приобретены навыки решения задачи оптимизации генетическим алгоритмом.