uiea.pas

这是一道很基本的程序

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

interface

uses
  uUtilsEA, Classes;

type

  IPopulation = interface;

  IIndividual = interface
  ['{BD6061C1-8529-11D6-8252-00C04F2859BF}']
    procedure SetFitness(const Value: TFloat);
    function GetFitness: TFloat;
    property Fitness: TFloat read GetFitness write SetFitness;
  end;

  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}']
    procedure SetPercentage(const Value: TFloat);
    function GetPercentage: TFloat;
    // function Kill(Pop : IPopulation) : Integer;
    // 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}']
    function GetIndividual(I: Integer): IIndividual;
    function GetCount: Integer;
    function GetBreeder: IBreeder;
    function GetCreator: ICreator;
    function GetExaminer: IExaminer;
    function GetKiller: IKiller;
    function GetMutator: IMutator;
    function GetOnChange: TNotifyEvent;
    function GetParentSelector: IParentSelector;
    procedure SetBreeder(const Value: IBreeder);
    procedure SetCreator(const Value: ICreator);
    procedure SetExaminer(const Value: IExaminer);
    procedure SetKiller(const Value: IKiller);
    procedure SetMutator(const Value: IMutator);
    procedure SetOnChange(const Value: TNotifyEvent);
    procedure SetParentSelector(const Value: IParentSelector);
    // Adds an individual to the population
    procedure Add(New : IIndividual);
    // Deletes an individual from the population
    procedure Delete(I : Integer);
    // Runs a single generation
    procedure Generation;
    // Initialise the population
    procedure Initialise(Size : Integer);
    // Clear ourselves out
    procedure Clear;
    // Get the fitness of an individual
    function FitnessOf(I : Integer) : TFloat;
    // Access to the population members
    property Pop[I : Integer] : IIndividual read GetIndividual; default;
    // The size of the population
    property Count : Integer read GetCount;
    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;
    // An event
    property OnChange : TNotifyEvent read GetOnChange write SetOnChange;
  end;

implementation

end.