Применение генетических алгоритмов

        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 }

        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_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_5;

        1: Target := Rasstrigin;

        2: Target := Griewank;

      end;

      CreateImage;

    end; 

    procedure TfrmMain.btnStopClick(Sender: TObject);

    begin

      StopFlag := True;

    end; 

    end. 

 

     Литература 

1. Вентцель  Е.С. «Исследование операций», - М.: 1972 г. – 245 с.
2. Галушкин А. Современные направления развития нейрокомпьютерных технологий в России // Открытые системы. - 1997 г., №4.
3. Гальцына О.Л., Попов И.И.   «Основы алгоритмизации и программирования». – 300 с.
4. Грешилов А.А.  «Как принять наилучшее решение в реальных условиях», - М.: 1991 г. – 278 с.
5. Де Джонг К. А. Введение ко второму специальному выпуску по

генетическим  алгоритмам. Машинное обучение, №5(4)

6. Каллан Р. Основные концепции нейронных сетей. М.: Вильямс 2002 г. – 300 с.
7. Комарцова Л.Г., Максимов А.В. Нейрокомпьютеры: Учеб. пособие для вузов. - 2-е изд., перераб. и доп. - М.: Изд-во МГТУ им. Н.Э. Баумана, 2004. - 400 с: ил.
8. Корнеев В.В., Гареев А.Ф. «Базы данных. Интеллектуальная обработка данных», М.: 2001г. – 220с.
9. Коршунов Ю.М. «Математические основы кибернетики. Для студентов вузов», - М.: 1987 г. – 410 с.
10. Леонов О.И.   «Теория графов». – 356 с.
11. Логовский А. Новейшая история нейрокомпьютинга в России //Открытые системы. – 2001 г., №3.
12. Майника Э., «Алгоритмы оптимизации на сетях и графах.» - М.: 1981 – 360 с.
13. Новиков Ф.А. «Дискретная математика для программистов». – 280 с.
14. Оссовский С. Нейронные сети для обработки информации / Пер. с польского И.Д. Рудинского. - М.: Финансы и статистика, 2002. - 344 с: ил.
15. Рутковская Д., Пилиньский М., Рутковский Л. Нейронные сети, генетические алгоритмы и нечеткие системы: Пер. с польск. И. Д. Рудинского. - М.: Горячая линия -Телеком, 2006. - 452 с: ил.
16. Стюарт Рассел, Питер Норвиг. Искусственный интеллект: современный подход. 2-е издание М., Вильямс 2006 г. – 354 с.
17. Тархов Д.А. Нейронные сети. Модели и алгоритмы. Изд: Радиотехника. 2005 г. – 370 с.
18. Уоссермен Ф. Нейрокомпьютерная техника. Теория и практика. М.: Мир, 1992 г. – 240 с.
19. Яхъяева Г. Э. Нечеткие множества и нейронные сети: Учебное пособие /Г. Э. Яхъяева. - М.: Интернет-Университет Информационных Технологий; БИНОМ. Лаборатория знаний, 2006. – 420 с.