Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

II8

.odt
Скачиваний:
28
Добавлен:
06.05.2017
Размер:
49.49 Кб
Скачать

Евдокимов Никита

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.

Результаты работы:

Вывод: в ходе выполнения лабораторной работы были приобретены навыки решения задачи оптимизации генетическим алгоритмом.

Соседние файлы в предмете Искусственный интеллект