fea_tsp.~pas

这是一道很基本的程序

{ This program is interface-based implementation of
  Dan Taylor's ([e-mail],
           http://www.logicalgenetics.com/index.php)
  Evolutionary TSP Algorithm demo program
Modified: September 2002
  by Nikolai Shokhirev ([e-mail],
  http://www.chem.arizona.edu/~shokhirn/index.html) }
unit fEA_TSP;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Spin, ComCtrls, uIEA, uITSP, uUtilsEA, uDisplayTSP;

type
  TFormGA = class(TForm)
    PanelFit: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    PanelDisp: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Label2: TLabel;
    EditNoCities: TSpinEdit;
    EditPopulationSize: TSpinEdit;
    EditKill: TSpinEdit;
    EditInversion: TSpinEdit;
    EditTransposition: TSpinEdit;
    EditGens: TSpinEdit;
    ButtonRun: TButton;
    ButtonStep: TButton;
    ButtonCreateCities: TButton;
    ButtonCreatePop: TButton;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    StatusBar1: TStatusBar;
    Panel7: TPanel;
    Label1: TLabel;
    ListBox1: TListBox;
    Label7: TLabel;
    Bevel3: TBevel;
    procedure FormCreate(Sender: TObject);
    procedure ButtonCreateCitiesClick(Sender: TObject);
    procedure ButtonCreatePopClick(Sender: TObject);
    procedure ButtonStepClick(Sender: TObject);
    procedure ButtonRunClick(Sender: TObject);
    procedure EditKillChange(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure EditTranspositionChange(Sender: TObject);
    procedure EditInversionChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    { Private declarations }
    fGenerations: integer;
    Display: TTSPDisplay;
    Controller: ITSPController;
    BreederCrossover: IBreeder;
    Examiner: ITSPExaminer;
    Creator: ITSPCreator;
    KillerPercentage: IKillerPercentage;
    Mutator: ITSPMutator;
    Population: IPopulation;
    ParentSelectorTournament: IParentSelector;
    pFit: TPainter0;
    ArrFit: array of TFloat;
    ArrFitLen: integer;
    ArrFitPos: integer;
    BitmapF: TBitmap;
    procedure PopulationChange(Sender: TObject);
    procedure SetGenerations(const Value: integer);
    procedure ClearGraph;
    procedure DrawFit;
    procedure Plot(D: TFloat);
    procedure pFitPaint(Sender: TObject);
    procedure DisplayPaint(Sender: TObject);
  public
    { Public declarations }
    property Generations : integer read fGenerations write SetGenerations;
  end;

var
  FormGA: TFormGA;

implementation

uses
  uEA;

{$R *.DFM}

procedure TFormGA.FormCreate(Sender: TObject);
begin
  Randomize;
  Display := TTSPDisplay.Create(self,PanelDisp);
  Display.SetRanges(0.0,11.0,0.0,11.0,1.0);
  Display.BgColor := clWhite;
  Display.Clear;

  Controller := TTSPController.Create;
  Controller.Xmin := Display.Xmin;
  Controller.Xmax := Display.Xmax;
  Controller.Ymin := Display.Ymin;
  Controller.Ymax := Display.Ymax;

  Display.Controller := Controller;

  Creator := TTSPCreator.Create;
  Creator.Controller := Controller;

  BreederCrossover := TTSPBreederCrossover.Create;

  Examiner := TTSPExaminer.Create;
  Examiner.Controller := Controller;

  KillerPercentage := TKillerPercentage.Create;

  Mutator := TTSPMutator.Create;

  ParentSelectorTournament := TParentSelectorTournament.Create;

  Population := TPopulation.Create;
  Population.Breeder := BreederCrossover;
  Population.Examiner := Examiner;
  Population.Creator := Creator;
  Population.Killer := KillerPercentage;
  Population.Mutator := Mutator;
  Population.ParentSelector := ParentSelectorTournament;
  Population.OnChange := PopulationChange;

  pFit := TPainter0.Create(self,PanelFit);
  pFit.BgColor := clWhite;
  pFit.PenWidth := 3;
  pFit.PenColor := clRed;
  pFit.BrushColor := clRed;
  pFit.Clear;

  BitmapF := TBitmap.Create;
  BitmapF.Canvas.Pen.Color := pFit.PenColor;

  EditKillChange(self);
  EditTranspositionChange(self);
  EditInversionChange(self);
end;

procedure TFormGA.FormDestroy(Sender: TObject);
begin
  BitmapF.Free;
end;

procedure TFormGA.SetGenerations(const Value: integer);
begin
  fGenerations := Value;
  StatusBar1.Panels[0].Text := 'Gens: ' + IntToStr(Value);
end;

procedure TFormGA.ButtonCreateCitiesClick(Sender: TObject);
begin
  Population.Clear;
  Generations := 0;
  ClearGraph;
  Display.Controller.CityCount := EditNoCities.Value;
  Display.DrawMap;
  ButtonCreatePop.Enabled := true;
end;

procedure TFormGA.ButtonCreatePopClick(Sender: TObject);
const
  d = 5;
begin
  Population.Initialise(EditPopulationSize.Value);
  Display.DrawMapWithRoute(Population[0] as ITSPIndividual);
  Display.OnPaint := DisplayPaint;
  Generations := 0;
  ArrFitLen := (pFit.ClientWidth - d) div d;
  SetLength(ArrFit, ArrFitLen);
  ArrFitPos := Low(ArrFit);
  ArrFit[ArrFitPos] := Population.FitnessOf(0);
  pFit.SetRanges(ArrFitPos,ArrFitLen,0.0,ArrFit[ArrFitPos],-1.0);
  DrawFit;
  pFit.OnPaint := pFitPaint;
  ButtonRun.Enabled := true;
  ButtonStep.Enabled := true;
end;

procedure TFormGA.ClearGraph;
begin
  Display.Clear;
  pFit.Clear;
end;

procedure TFormGA.pFitPaint(Sender: TObject);
begin
  DrawFit;
end;

procedure TFormGA.DisplayPaint(Sender: TObject);
begin
  Display.DrawMapWithRoute(Population[0] as ITSPIndividual);
end;

procedure TFormGA.DrawFit;
var
  i: integer;
begin
  with BitmapF do
  begin
    Width := pFit.ClientWidth;
    Height := pFit.ClientHeight;
    Canvas.Brush.Color := clWhite;
    Canvas.FillRect(pFit.ClientRect);
    Canvas.Brush.Color := clRed;
    for i := Low(ArrFit) to ArrFitPos do
    begin
      Canvas.FillRect(pFit.rRect2iRect(i,i+1,0.0, ArrFit[i]));
    end;
  end;
// to prevent flickering
  pFit.Canvas.Draw(0,0,BitmapF);
end;

procedure TFormGA.Plot(D: TFloat);
var
  i: integer;
begin
  if ArrFitPos < High(ArrFit) then
  begin
    Inc(ArrFitPos);
  end else
  begin
    ArrFitPos := High(ArrFit);
    for i := Low(ArrFit) to ArrFitPos-1 do
      ArrFit[i] := ArrFit[i+1];
  end;
  ArrFit[ArrFitPos] := D;
  DrawFit;
end;

procedure TFormGA.ButtonStepClick(Sender: TObject);
begin
  Population.Generation;
  Display.DrawMapWithRoute(Population[0] as ITSPIndividual);
  Generations := Generations + 1;
  Plot(Population.FitnessOf(0));
end;

procedure TFormGA.ButtonRunClick(Sender: TObject);
var
  i : Integer;
begin
  for i := 1 to EditGens.Value do
  begin
    Population.Generation;
    Display.DrawMapWithRoute(Population[0] as ITSPIndividual);
    Generations := Generations + 1;
    Plot(Population.FitnessOf(0));
    Application.ProcessMessages;
  end;
end;

procedure TFormGA.PopulationChange(Sender: TObject);
var
  i : Integer;
begin
  ListBox1.Clear;

  for i := 0 to Population.Count - 1 do
  begin
    ListBox1.Items.Add(IntToStr(i+1)+': '+FloatToStr(Population.FitnessOf(i)))
  end;
end;

procedure TFormGA.EditKillChange(Sender: TObject);
begin
  KillerPercentage.Percentage := EditKill.Value;
end;

procedure TFormGA.ListBox1Click(Sender: TObject);
begin
  Display.DrawMapWithRoute(Population[ListBox1.ItemIndex] as ITSPIndividual);
end;

procedure TFormGA.EditTranspositionChange(Sender: TObject);
begin
  Mutator.Transposition := EditTransposition.Value;
end;

procedure TFormGA.EditInversionChange(Sender: TObject);
begin
  Mutator.Inversion := EditInversion.Value;
end;

procedure TFormGA.FormResize(Sender: TObject);
begin
  Display.SetRanges(0.0,11.0,0.0,11.0,1.0);
end;

end.