uea.pas

这是一道很基本的程序

    end;  
  // Return the child
  Result := Child;
  end;

{ TTSPMutator }

function TTSPMutator.GetInv: TFloat;
begin
  result := fInv;
end;

function TTSPMutator.GetTrans: TFloat;
begin
  result := fTrans;
end;

procedure TTSPMutator.Mutate(Individual: IIndividual);
var
  P: Double;  
  i, j, t       : Integer;  Start, Finish : Integer;
begin  
  with Individual as ITSPIndividual do
  begin    
    // Should we do an inversion?    
    P := Random * 100;    
    if P < FTrans then    
    begin      
      // Do an inversion (i.e. swap two cities at random)      
      // Choose first city
      i := Random(Steps);      
      // Choose a second city      
      repeat        
        j := Random(Steps);      
      until i <> j;      
      // Swap them over
      t := RouteArray[i];
      RouteArray[i] := RouteArray[j];
      RouteArray[j] := t;
    end;
    // Should we do a transposition?
    P := Random * 100;
    if P < FInv then
    begin
      // Do a transposition (i.e. reverse a sub-route)
      // Choose random start and finish points
      Start := Random(Steps - 1);
      Finish := Start + Random(Steps - Start);
      // Reverse the sub-route
      for i := 0 to Floor((Finish - Start) / 2) do
      begin
        t := RouteArray[Start + i];
        RouteArray[Start + i] := RouteArray[Finish - i];
        RouteArray[Finish - i] := t;
      end;
    end;
  end;
end;

procedure TTSPMutator.SetInv(const Value: TFloat);
begin
  fInv := Value;
end;

procedure TTSPMutator.SetTrans(const Value: TFloat);
begin
  fTrans := Value;
end;

{ TTSPExaminer }

function TTSPExaminer.GetController: ITSPController;
begin
  result := fController;
end;

function TTSPExaminer.GetFitness(Individual: IIndividual): TFloat;
var
  i        : Integer;
  Distance : Double;
  Indi     : ITSPIndividual;
begin
  Indi := Individual as ITSPIndividual;
  Distance := 0;
  for i := 0 to Indi.Steps - 2 do
  begin
    Distance := Distance + fController.DistanceBetween(Indi.RouteArray[i], Indi.RouteArray[i + 1]);
  end;
  Distance := Distance + fController.DistanceBetween(Indi.RouteArray[Indi.Steps - 1], Indi.RouteArray[0]);
  Result := Distance;
end;

procedure TTSPExaminer.SetController(const Value: ITSPController);
begin
  fController := Value;
end;

{ TPopulation }

constructor TPopulation.Create;
begin
  inherited;
  fPop := TInterfaceList.Create;
end;

destructor TPopulation.Destroy;
begin
  fPop.Free;
  inherited;
end;

procedure TPopulation.Add(New: IIndividual);
begin
  fPop.Add(New);
end;

procedure TPopulation.Clear;
begin
  fPop.Clear;
end;

function TPopulation.CompareIndividuals(I1, I2: IIndividual): Integer;
var
  A, B, D : TFloat;
begin
  // Get the difference between the two individuals (real number)
  A := I1.Fitness;
  B := I2.Fitness;

  D := A - B;

  // Quickest way to convert that to an integer is...
  if D > 0 then
    Result := 1
  else if D < 0 then
    Result := -1
  else
    Result := 0;
end;

procedure TPopulation.Delete(I: Integer);
begin
  fPop.Delete(I);
end;

function TPopulation.FitnessOf(I: Integer): TFloat;
begin
  result := Pop[I].Fitness;
end;

procedure TPopulation.Change;
begin
  if Assigned(fOnChange) then
    FOnChange(Self);
end;

procedure TPopulation.Generation;
var
  Replace, i : Integer;
  New        : IIndividual;
begin
  // Kill some of the population
  Replace := fKiller.Kill(Self);

  for i := 1 to Replace do
  begin
    // Breed a new individual
    New := fBreeder.BreedOffspring(fParentSelector, Self);
    // Perform some mutation on the individual
    FMutator.Mutate(New);
    // Get the fitness of the new individual
    New.Fitness := fExaminer.GetFitness(New);
    // Add it to the population
    Add(New);
  end;
  // Sort the population into fitness order where first <==> best
  SortPopulation;

  Change;
end;

function TPopulation.GetBreeder: IBreeder;
begin
  result := fBreeder;
end;

function TPopulation.GetCount: Integer;
begin
  result := fPop.Count;
end;

function TPopulation.GetCreator: ICreator;
begin
  result := fCreator;
end;

function TPopulation.GetExaminer: IExaminer;
begin
  result := fExaminer;
end;

function TPopulation.GetIndividual(I: Integer): IIndividual;
begin
  result := (fPop[I] as IIndividual);
end;

function TPopulation.GetKiller: IKiller;
begin
  result := fKiller;
end;

function TPopulation.GetMutator: IMutator;
begin
  result := fMutator;
end;

function TPopulation.GetOnChange: TNotifyEvent;
begin
  result := fOnChange;
end;

function TPopulation.GetParentSelector: IParentSelector;
begin
  result := fParentSelector;
end;

procedure TPopulation.Initialise(Size: Integer);
var
  i: Integer;
  New: IIndividual;
begin
  // Clear out the old stuff
  Clear;
  // Set the capacity first to save about 12 nanoseconds ;o)
  fPop.Capacity := Size;
  // Create the appropriate number of individuals
  for i := 1 to Size do
  begin
    // Create the individual
    New := fCreator.CreateIndividual;
    // Get the fitness of the new individual
    New.Fitness := fExaminer.GetFitness(New);
    // Add to the population
    Add(New);
  end;
  SortPopulation;
  Change;
end;

procedure TPopulation.SetBreeder(const Value: IBreeder);
begin
  fBreeder := Value;
end;

procedure TPopulation.SetCreator(const Value: ICreator);
begin
  fCreator := Value;
end;

procedure TPopulation.SetExaminer(const Value: IExaminer);
begin
  fExaminer := Value;
end;

procedure TPopulation.SetKiller(const Value: IKiller);
begin
  fKiller := Value;
end;

procedure TPopulation.SetMutator(const Value: IMutator);
begin
  fMutator := Value;
end;

procedure TPopulation.SetOnChange(const Value: TNotifyEvent);
begin
  fOnChange := Value;
end;

procedure TPopulation.SetParentSelector(const Value: IParentSelector);
begin
  fParentSelector := Value;
end;

procedure TPopulation.DanQuickSort(SortList: TInterfaceList; L, R: Integer;
  SCompare: TInterfaceCompare);
var
  I, J: Integer;
  P: IIndividual;
begin
  repeat
    I := L;
    J := R;
    P := SortList.Items[(L + R) div 2] as IIndividual;
    repeat
      while SCompare(SortList.Items[I] as IIndividual, P) < 0 do
        Inc(I);
      while SCompare(SortList.Items[J] as IIndividual, P) > 0 do
        Dec(J);
      if I <= J then
      begin
        SortList.Exchange(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      DanQuickSort(SortList, L, J, SCompare);
    L := I;
  until I >= R;
end;

procedure TPopulation.Sort(Compare: TInterfaceCompare);
begin
  if Assigned(fPop) and (Count > 0) then
    DanQuickSort(fPop, 0, Count - 1, Compare);
end;

procedure TPopulation.SortPopulation;
begin
  Sort(self.CompareIndividuals);
end;

{ TTSPController }

constructor TTSPController.Create;
begin
  inherited;
end;

destructor TTSPController.Destroy;
begin
  SetLength(FCities, 0);
  inherited;
end;

{  Standard euclidian distance between two 2D vectors...  }
function TTSPController.DistanceBetween(C1, C2: Integer): TFloat;
begin
  Result := Sqrt(sqr(Cities[C1].X - Cities[C2].X)
           +     sqr(Cities[C1].Y - Cities[C2].Y));
end;


function TTSPController.GetCity(I: Integer): TPoint2D;
begin
  result := fCities[I];
end;

function TTSPController.GetCityCount: Integer;
begin
  result := fCityCount;
end;

function TTSPController.GetXmax: TFloat;
begin
  result := fXmax;
end;

function TTSPController.GetXmin: TFloat;
begin
  result := fXmin;
end;

function TTSPController.GetYmax: TFloat;
begin
  result := fYmax;
end;

function TTSPController.GetYmin: TFloat;
begin
  result := fYmin;
end;

procedure TTSPController.RandomCities;
var
  i : Integer;
begin
  for i := 0 to FCityCount - 1 do
  begin
    FCities[i].X := Xmin+0.5+(Xmax-Xmin-1.0)*Random;
    FCities[i].Y := Ymin+0.5+(Ymax-Ymin-1.0)*Random;
  end;
end;

procedure TTSPController.SetCityCount(const Value: Integer);
begin
  SetLength(fCities, Value);
  fCityCount := Value;

  RandomCities;
end;

procedure TTSPController.SetXmax(const Value: TFloat);
begin
  fXmax := Value;
end;

procedure TTSPController.SetXmin(const Value: TFloat);
begin
  fXmin := Value;
end;

procedure TTSPController.SetYmax(const Value: TFloat);
begin
  fYmax := Value;
end;

procedure TTSPController.SetYmin(const Value: TFloat);
begin
  fYmin := Value;
end;

end.