Genetic Algorithm

The Traveling Salesman Problem

by Nikolai Shokhirev

Introduction

This is an interface-based implementation of Dan Taylor's  Evolutionary TSP Algorithm demo program.  At that website you can also find his article "Introduction to Evolutionary Algorithms" , PowerPoint presentation and the source code for two examples.

Our implementation of this classical optimization problem can be downloaded here

Below are some comments to the code.

List of units

unit fEA_TSP;  { main form }
unit uIEA;     { Generic interfaces }
unit uITSP;    { TSP-specific Interfaces }
unit uEA;      { Implementation of all interfaces }
unit uUtilsEA; { type definitions }

General interfaces

General-purpose interfaces - nothing TSP-specific:

  IIndividual = interface
  ['{BD6061C1-8529-11D6-8252-00C04F2859BF}']
    procedure SetFitness(const Value: TFloat);
    function GetFitness: TFloat;
    property Fitness: TFloat read GetFitness write SetFitness;
  end;
// Here and later "Getters" and "Setters" for properties are omitted (see the complete code)

  TInterfaceCompare = function (Item1, Item2: IIndividual): Integer of object;

  ICreator = interface
  ['{BD6061C2-8529-11D6-8252-00C04F2859BF}']
    // Function is used to create individuals to form the initial population
    function CreateIndividual: IIndividual;
  end;

  IKiller = interface
  ['{BD6061C3-8529-11D6-8252-00C04F2859BF}']
    // Function to kill off some unfit population members
    // should delete them from the list and return the number killed
    function Kill(Pop: IPopulation) : Integer;
  end;

  IKillerPercentage = interface(IKiller)
  ['{BD6061C4-8529-11D6-8252-00C04F2859BF}']
    // Percentage of population to be killed
    property Percentage : TFloat read GetPercentage write SetPercentage;
  end;

  IParentSelector = interface
  ['{BD6061C5-8529-11D6-8252-00C04F2859BF}']
    // This function returns a reference to a single parent, selected from Pop
    function SelectParent(Population: IPopulation): IIndividual;
  end;

  IBreeder = interface
  ['{BD6061C6-8529-11D6-8252-00C04F2859BF}']
    // This function should return a new population member based on parents
    // selected using the ParentSelector object
    function BreedOffspring(PSelector: IParentSelector; Pop: IPopulation): IIndividual;
  end;

  IMutator = interface
  ['{BD6061C7-8529-11D6-8252-00C04F2859BF}']
    // This function performs mutation(s) on the individual passed
    procedure Mutate(Individual: IIndividual);
  end;

  IExaminer = interface
  ['{BD6061C8-8529-11D6-8252-00C04F2859BF}']
    // Returns the fitness of an individual, where lower <=> better
    function GetFitness(Individual: IIndividual) : TFloat;
  end;

  IPopulation = interface
  ['{BD6061C9-8529-11D6-8252-00C04F2859BF}']
    procedure Add(New: IIndividual); // Adds an individual to the population
    procedure Delete(I: Integer); // Deletes an individual from the population
    procedure Generation; // Runs a single generation
    procedure Initialise(Size: Integer); // Initialise the population
    procedure Clear; // Clear ourselves out
    function FitnessOf(I: Integer): TFloat; // Get the fitness of an individual
    // Access to the population members
    property Pop[I: Integer]: IIndividual read GetIndividual; default;
    property Count: Integer read GetCount; // The size of the population
    property ParentSelector: IParentSelector read GetParentSelector write SetParentSelector;
    property Breeder : IBreeder read GetBreeder write SetBreeder;
    property Killer : IKiller read GetKiller write SetKiller;
    property Mutator : IMutator read GetMutator write SetMutator;
    property Creator : ICreator read GetCreator write SetCreator;
    property Examiner : IExaminer read GetExaminer write SetExaminer;
    property OnChange : TNotifyEvent read GetOnChange write SetOnChange;
  end;

TSP-specific interfaces

ITSPIndividual = interface(IIndividual)
  ['{BD6061CA-8529-11D6-8252-00C04F2859BF}']
    property RouteArray[I: Integer]: Integer read GetRouteArray write SetRouteArray;
    property Steps: Integer read GetSteps write SetSteps;
  end;

// interface for communication with Display object (see below)
  ITSPController = interface
  ['{BD6061CB-8529-11D6-8252-00C04F2859BF}']
    {  Get the distance between two cities }
    function DistanceBetween(C1, C2 : Integer) : TFloat;
    procedure RandomCities; {  Places the cities at random points }
    { Area limits }
    property Xmin: TFloat read GetXmin write SetXmin;
    property Xmax: TFloat read GetXmax write SetXmax;
    property Ymin: TFloat read GetYmin write SetYmin;
    property Ymax: TFloat read GetYmax write SetYmax;
    {  Access to the cities array }
    property Cities[I: Integer] : TPoint2D read GetCity;
    {  Properties... }
    property CityCount: Integer read GetCityCount write SetCityCount;
  end;

  ITSPDisplay = interface
  ['{BD6061CC-8529-11D6-8252-00C04F2859BF}']
    procedure DrawMap; {  Call this to draw the map }
    {  Draw the map with a route  }
    procedure DrawMapWithRoute(Individual : ITSPIndividual);
  end;

  ITSPCreator = interface(ICreator)
  ['{BD6061CD-8529-11D6-8252-00C04F2859BF}']
    function CreateIndividual : IIndividual;
    property Controller : ITSPController read GetController write SetController;
  end;

  ITSPMutator = interface(IMutator)
  ['{BD6061CE-8529-11D6-8252-00C04F2859BF}']
    // Probability of doing a transposition
    property Transposition : TFloat read GetTrans write SetTrans;
    // Probability of doing an inversion
    property Inversion : TFloat read GetInv write SetInv;
  end;

  ITSPExaminer = interface(IExaminer)
  ['{BD6061CF-8529-11D6-8252-00C04F2859BF}']
    // Returns the fitness of an individual as a real number where 0 => best
    property Controller : ITSPController read GetController write SetController;
  end; 
 

Display object

This object is used instead of TChart components in Dan Taylor's original implementation. It is created dynamically at run-time and should not be installed. 

  TTSPDisplay = class(TPainter0)
  private
    fController: ITSPController;
    {  Clear the map }
//    procedure Clear;  //it exists in the base class
    procedure DrawCities; { Show the cities }
    procedure DrawRoute(Individual: ITSPIndividual); {  Display a route  }
  public
    constructor Create(aOwner: TComponent; aParent: TWinControl);
    destructor Destroy; override;
    procedure DrawMap; { Call this to draw the map }
    {  Draw the map with a route  }
    procedure DrawMapWithRoute(Individual: ITSPIndividual);
    property Controller: ITSPController read GetController write SetController;
  end;

 

©Nikolai Shokhirev, 2002 - 2016.


Rule

Home  |   Shokhirev.com  |   Other Projects  |   Programming  |   Publications  |   Resume
[Mailbox]

Please e-mail me at nikolai@shokhirev.com