Генетические алгоритмы

{ **** UBPFD *********** by kladovka.net.ru ****
>> Генетические алгоритмы
 
Класс, реализующий генетический алгоритм.
 
Зависимости: Classes, SysUtils, Windows, Math
Автор:       Mystic, mystic2000@newmail.ru, ICQ:125905046, Харьков
Copyright:   Mystic
Дата:        25 апреля 2002 г.
********************************************** }
 
unit Genes;
 
interface
 
uses {Fuzzy,} Classes, SysUtils, Windows, Math;
 
type
  TGeneAlgorithm = class;
  TExtendedArray = array of Extended;
 
  TEstimateEvent = procedure (Sender: TObject; const X: TExtendedArray; var Y: Extended) of object;
  TIterationEvent = procedure (Sender: TObject; Iteration: Integer);
  TBestChangeEvent = procedure (Sender: TObject; BestEstimate: Extended);
 
  EGeneError = class(Exception) end;
 
  TCardinalArray = array of Cardinal;
  TGeneRecord = record
    Bits: TCardinalArray;
    Values: TExtendedArray;
    Estimate: Extended;
  end;
  TGeneRecords = array of TGeneRecord;
 
  TSolutionThread = class(TThread)
  private
    FOwner: TGeneAlgorithm;
  protected
    procedure Execute; override;
    property Owner: TGeneAlgorithm read FOwner;
  public
    constructor Create(AOwner: TGeneAlgorithm);
  end;
 
  TGeneState = (gsExecute, gsSuspend, gsTune);
 
  TGeneAlgorithm = class
  private
    FData: array of TGeneRecord; // Algorithm data
    FLock: TRTLCriticalSection;
    FLowValues: TExtendedArray;
    FHighValues: TExtendedArray;
    FSolutionThread: TSolutionThread;
    FMutation: Extended;
    FInversion: Extended;
    FCrossover: Extended;
    FMaxPopulation: Integer;
    FBitPerNumber: Integer;
    FMinPopulation: Integer;
    FDimCount: Integer;
    FOnBestChange: TBestChangeEvent;
    FOnEstimate: TEstimateEvent;
    FOnIteration: TIterationEvent;
    FIteration: Integer;
// FBestEstimate: Extended;
    FState: TGeneState;
 
    BitSize: Integer;
 
    function GetBestEstimate: Extended;
    function GetHighValues(I: Integer): Extended;
    function GetIteration: Integer;
    function GetLowValues(I: Integer): Extended;
    procedure SetBitPerNumber(const Value: Integer);
    procedure SetCrossover(const Value: Extended);
    procedure SetDimCount(const Value: Integer);
    procedure SetHighValues(I: Integer; const Value: Extended);
    procedure SetInversion(const Value: Extended);
    procedure SetLowValues(I: Integer; const Value: Extended);
    procedure SetMaxPopulation(const Value: Integer);
    procedure SetMinPopulation(const Value: Integer);
    procedure SetMutation(const Value: Extended);
    procedure SetOnBestChange(const Value: TBestChangeEvent);
    procedure SetOnEstimate(const Value: TEstimateEvent);
    procedure SetOnIteration(const Value: TIterationEvent);
    procedure Lock;
    procedure Unlock;
    function GetBestX(I: Integer): Extended;
    function GetState: TGeneState;
 
    procedure DoCrossover(N: Integer);
    procedure DoMutation(N: Integer);
    procedure DoInversion(N: Integer);
 
    procedure EstimatePopulation(StartIndex: Integer);
    procedure SortPopulation;
    procedure MakeChild;
 
  public
    // Creation & destroying
    constructor Create;
    destructor Destroy; override;
 
    // Running / stopping
    procedure Run;
    procedure Abort;
    procedure Suspend;
    procedure Resume;
 
    // Saving / opening
    procedure LoadFromStream(S: TStream);
    procedure SaveToStream(S: TStream);
 
    // Algorithm param
    property BitPerNumber: Integer read FBitPerNumber write SetBitPerNumber;
    property MaxPopulation: Integer read FMaxPopulation write SetMaxPopulation;
    property MinPopulation: Integer read FMinPopulation write SetMinPopulation;
    property Crossover: Extended read FCrossover write SetCrossover;
    property Mutation: Extended read FMutation write SetMutation;
    property Inversion: Extended read FInversion write SetInversion;
    property DimCount: Integer read FDimCount write SetDimCount;
    property LowValues[I: Integer]: Extended read GetLowValues write SetLowValues;
    property HighValues[I: Integer]: Extended read GetHighValues write SetHighValues;
 
    // Info property
    property Iteration: Integer read GetIteration;
    property BestX[I: Integer]: Extended read GetBestX;
    property BestEstimate: Extended read GetBestEstimate;
    property State: TGeneState read GetState;
 
    // Events
    property OnEstimate: TEstimateEvent read FOnEstimate write SetOnEstimate;
    property OnIteration: TIterationEvent read FOnIteration write SetOnIteration;
    property OnBestChange: TBestChangeEvent read FOnBestChange write SetOnBestChange;
 
  end;
 
implementation
 
resourcestring
  SCannotSetParam = 'Невозможно установить параметр %s в состоянии %s';
  SCannotGetParam = 'Невозможно прочитать параметр %s в состоянии %s';
  SInvalidParam = 'Параметр %s не может быть %s (%d).';
  SNonPositive = 'отрицательным или нулевым';
  SInvalidProbality = 'вероятность %s должна быть в диапазоне 0..1 (%f).';
  SLess2 = 'меньше двух';
  SEmpty = 'Неправильный индекс при обращении к %s (%d) при нулевом количества элементов.';
  SInvalidIndex = 'Неправильный индекс при обращении к %s (%d). Индекс должен лежать в диапазоне от %d до %d';
  SNonEstimate = 'Не задана функция оценки.';
 
const
  SState: array[TGeneState] of string = (
    'настройки параметров алгоритма',
    'работы алгоритма',
    'остановки алгоритма');
 
{ TGeneAlgorithm }
 
procedure TGeneAlgorithm.Abort;
var
  I: Integer;
begin
  if FState=gsExecute then
  begin
    FSolutionThread.Terminate;
    FSolutionThread.WaitFor;
  end;
  Lock;
  try
    for I:=0 to Length(FData)-1 do
    begin
      SetLength(FData[I].Bits, 0);
      SetLength(FData[I].Values, 0);
    end;
    SetLength(FData, 0);
    FState := gsTune;
  finally
    Unlock;
  end;
end;
 
constructor TGeneAlgorithm.Create;
begin
  InitializeCriticalSection(FLock);
  FBitPerNumber := 8;
  FMinPopulation := 5000;
  FMaxPopulation := 10000;
  FMutation := 0.1;
  FCrossover := 0.89;
  FInversion := 0.01;
  FDimCount := 0;
  FState := gsTune;
end;
 
destructor TGeneAlgorithm.Destroy;
begin
  Abort;
  DeleteCriticalSection(FLock);
  SetLength(FLowValues, 0);
  SetLength(FHighValues, 0);
  inherited;
end;
 
procedure TGeneAlgorithm.DoCrossover(N: Integer);
var
  I: Integer;
  Parent1, Parent2: Integer;
  Bit, ByteCount: Integer;
  BitPos: Byte;
  Mask: Integer;
begin
  Parent1 := Random(FMinPopulation);
  Parent2 := Random(FMinPopulation);
  Bit := Random(FDimCount*FBitPerNumber-1);
  ByteCount := Bit div 32;
  for I:=0 to ByteCount-1 do
    FData[N].Bits[I] := FData[Parent1].Bits[I];
  for I:=ByteCount+1 to BitSize-1 do
    FData[N].Bits[I] := FData[Parent2].Bits[I];
  BitPos := Bit - 32*ByteCount;
  asm
    MOV CL, BitPos
    MOV EAX, -1
    SHL EAX, CL
    MOV Mask, EAX
  end;
  FData[N].Bits[ByteCount] :=
    (FData[Parent1].Bits[ByteCount] and not Mask) or
    (FData[Parent2].Bits[ByteCount] and Mask);
end;
 
procedure TGeneAlgorithm.DoInversion(N: Integer);
 
function GetBit(Addr: Pointer; No: Integer): Byte; assembler;
asm
  MOV EAX, Addr
  MOV ECX, No
  BT [EAX], ECX
  SBB EAX, EAX
  AND EAX, 1
end;
 
procedure SetBit(Addr: Pointer; No: Integer; Value: Byte); assembler;
asm
  MOV EAX, Addr
  OR Value,Value
  JZ @@1
  BTS [EAX], No
  RET
@@1:
  BTR [EAX], No
  RET
end;
 
var
  Parent, Bit, I: Integer;
  B: Byte;
 
begin
  Parent := Random(FMinPopulation);
  Bit := Random(FDimCount*FBitPerNumber-1);
  FData[N].Bits := FData[Parent].Bits;
  repeat
    B := GetBit(FData[N].Bits, 0);
    for I:=0 to FDimCount*FBitPerNumber-2 do
      SetBit(FData[N].Bits, I, GetBit(FData[N].Bits, I+1));
    SetBit(FData[N].Bits, FDimCount*FBitPerNumber-1, B);
    if Bit=0 then Break;
    Bit := Bit - 1;
  until False;
end;
 
procedure TGeneAlgorithm.DoMutation(N: Integer);
var
  Parent: Integer;
  Bit, BitPos, ByteCount: Integer;
  Mask: Cardinal;
begin
  Parent := Random(FMinPopulation);
  Bit := Random(FDimCount*FBitPerNumber);
  ByteCount := Bit div 32;
  BitPos := Bit - 32 * ByteCount;
  Mask := 1 shl BitPos;
  FData[N].Bits := FData[Parent].Bits;
  FData[N].Bits[ByteCount] := FData[N].Bits[ByteCount] xor Mask;
end;
 
procedure TGeneAlgorithm.EstimatePopulation(StartIndex: Integer);
var
  I, J, K, Index: Integer;
  P, Q, Y: Extended;
  MaxWeight, Weight: Extended;
  Addr: Pointer;
  GrayBit, BinBit: Cardinal;
begin
  MaxWeight := Power(2, FBitPerNumber);
  for I:=StartIndex to Length(FData)-1 do
  begin
    Index := 0;
    Addr := FData[I].Bits;
    for J:=0 to FDimCount-1 do
    begin
      Weight := 0.5 * MaxWeight;
      P := 0.0;
      BinBit := 0;
 
      for K:=0 to FBitPerNumber-1 do
      begin
        asm
          MOV EAX, Addr
          MOV ECX, Index
          BT [EAX], ECX
          SBB EAX, EAX
          AND EAX, 1
          MOV GrayBit, EAX
          INC Index
        end;
        BinBit := BinBit xor GrayBit;
        if BinBit=1 then P := P + Weight;
        Weight := 0.5 * Weight;
      end;
 
      P := P / MaxWeight;
      Q := 1 - P;
      FData[I].Values[J] := P * FHighValues[J] + Q * FLowValues[J];
    end;
    Y := 0;
    FOnEstimate(Self, FData[I].Values, Y);
    FData[I].Estimate := Y;
  end;
end;
 
function TGeneAlgorithm.GetBestEstimate: Extended;
begin
  Lock;
  try
    Result := 0.0; //Kill warning
    if FState=gsTune then
      raise EGeneError.CreateFmt(SCannotGetParam, ['BestEstimate', SState[FState]]);
    Result := FData[0].Estimate;
  finally
    Unlock;
  end;
end;
 
function TGeneAlgorithm.GetBestX(I: Integer): Extended;
begin
  Lock;
  try
    Result := 0.0; // Kill warning
    if FState=gsTune then
      raise EGeneError.CreateFmt(SCannotGetParam, ['BestX', SState[FState]]);
    if (FDimCount=0) then
      raise EGeneError.CreateFmt(SEmpty, ['BestX', I]);
    if (I<0) or (I>=FDimCount) then
      raise EGeneError.CreateFmt(SInvalidIndex, ['BestX', I, 0, DimCount]);
    Result := FData[0].Values[I];
  finally
    Unlock;
  end;
end;
 
function TGeneAlgorithm.GetHighValues(I: Integer): Extended;
begin
  Lock;
  try
    Result := 0.0; // Kill warning
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotGetParam, ['HighValues', SState[FState]]);
    if (FDimCount=0) then
      raise EGeneError.CreateFmt(SEmpty, ['HighValues', I]);
    if (I<0) or (I>=FDimCount) then
      raise EGeneError.CreateFmt(SInvalidIndex, ['HighValues', I, 0, DimCount]);
    Result := FHighValues[I];
  finally
    Unlock;
  end;
end;
 
function TGeneAlgorithm.GetIteration: Integer;
begin
  Lock;
  try
    Result := 0; // Kill warning
    if FState=gsTune then
      raise EGeneError.CreateFmt(SCannotGetParam, ['Iteration', SState[FState]]);
    Result := FIteration;
  finally
    Unlock;
  end;
end;
 
function TGeneAlgorithm.GetLowValues(I: Integer): Extended;
begin
  Lock;
  try
    Result := 0.0; // Kill warning
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotGetParam, ['LowValues', SState[FState]]);
    if (FDimCount=0) then
      raise EGeneError.CreateFmt(SEmpty, ['LowValues', I]);
    if (I<0) or (I>=FDimCount) then
      raise EGeneError.CreateFmt(SInvalidIndex, ['LowValues', I, 0, DimCount]);
    Result := FLowValues[I];
  finally
    Unlock;
  end;
end;
 
function TGeneAlgorithm.GetState: TGeneState;
begin
  Lock;
  try
    Result := FState;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.LoadFromStream(S: TStream);
begin
 
end;
 
procedure TGeneAlgorithm.Lock;
begin
  EnterCriticalSection(FLock);
end;
 
procedure TGeneAlgorithm.MakeChild;
var
  I: Integer;
  RandomValue: Extended;
begin
  for I:=FMinPopulation to FMaxPopulation-1 do
  begin
    RandomValue := Random;
    if RandomValue<FCrossover then DoCrossover(I) else
    if RandomValue<FCrossover+FMutation then DoMutation(I) else
      DoInversion(I);
  end;
end;
 
procedure TGeneAlgorithm.Resume;
begin
  if FState <> gsSuspend then
    raise EGeneError.Create('Прежде чем возобновить, надо начать!');
  FSolutionThread.Create(Self);
  FState := gsExecute;
end;
 
procedure TGeneAlgorithm.Run;
var
  I, J: Integer;
  b1, b2: Cardinal;
begin
  Lock;
  try
    if not Assigned(FOnEstimate) then
      raise EGeneError.Create(SNonEstimate);
    Abort;
 
    try
 
      // Getting memory
      SetLength(FData, FMaxPopulation);
      for I:=0 to Length(FData)-1 do
      begin
        FData[I].Values := nil;
        FData[I].bits := nil;
      end;
      BitSize := FDimCount * FBitPerNumber + 31;
      BitSize := BitSize and not 31;
      BitSize := BitSize div 32;
      for I:=0 to Length(FData)-1 do
      begin
        SetLength(FData[I].Values, DimCount);
        SetLength(FData[I].Bits, BitSize);
      end;
 
      // Initializing Population
      for I:=0 to Length(FData)-1 do
      begin
        for J:=0 to BitSize-1 do
        begin
          b1 := Random(35536);
          b2 := Random(35536);
          FData[I].Bits[J] := b1 shl 16 + b2;
        end;
      end;
 
      EstimatePopulation(0);
      SortPopulation;
      FIteration := 0;
      FState := gsExecute;
      FSolutionThread := TSolutionThread.Create(Self);
 
    except
 
      Abort;
 
    end;
 
 
  finally
    Unlock;
  end;
 
 
end;
 
procedure TGeneAlgorithm.SaveToStream(S: TStream);
begin
 
end;
 
procedure TGeneAlgorithm.SetBitPerNumber(const Value: Integer);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['BitPerNumber', SState[FState]]);
    if Value<=0 then
      raise EGeneError.CreateFmt(SInvalidParam, ['BitPerNumber', SNonPositive, Value]);
    FBitPerNumber := Value;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetCrossover(const Value: Extended);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['Crossover', SState[FState]]);
    if (Value<0) or (Value>1) then
      raise EGeneError.CreateFmt(SInvalidProbality, ['кроссовера', Value]);
    FCrossover := Value;
    if FCrossover + FMutation > 1.0 then
    begin
      FMutation := 1.0 - FCrossover;
      FInversion := 0.0;
    end
    else begin
      FInversion := 1.0 - FMutation - FCrossover;
    end;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetDimCount(const Value: Integer);
var
  I: Integer;
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['DimCount', SState[FState]]);
    if FDimCount=Value then Exit;
    if Value<=0 then
      raise EGeneError.CreateFmt(SInvalidParam, ['DimCount', SNonPositive, Value]);
    SetLength(FLowValues, Value);
    SetLength(FHighValues, Value);
    for I:=FDimCount to Value-1 do
    begin
      FLowValues[I] := 0.0;
      FHighValues[I] := 1.0;
    end;
    FDimCount := Value;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetHighValues(I: Integer; const Value: Extended);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['HighValues', SState[FState]]);
    if (FDimCount=0) then
      raise EGeneError.CreateFmt(SEmpty, ['HighValues', Value]);
    if (I<0) or (I>=FDimCount) then
      raise EGeneError.CreateFmt(SInvalidIndex, ['HighValues', Value, 0, DimCount]);
    FHighValues[I] := Value;
    if FLowValues[I] > FHighValues[I] then
      FLowValues[I] := FHighValues[I];
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetInversion(const Value: Extended);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['Crossover', SState[FState]]);
    if (Value<0) or (Value>1) then
      raise EGeneError.CreateFmt(SInvalidProbality, ['инверсии', Value]);
    FInversion := Value;
    if FCrossover + FInversion > 1.0 then
    begin
      FCrossover := 1.0 - FInversion;
      FMutation := 0.0;
    end
    else begin
      FMutation := 1.0 - FInversion - FCrossover;
    end;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetLowValues(I: Integer; const Value: Extended);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['LowValues', SState[FState]]);
    if (FDimCount=0) then
      raise EGeneError.CreateFmt(SEmpty, ['LowValues', Value]);
    if (I<0) or (I>=FDimCount) then
      raise EGeneError.CreateFmt(SInvalidIndex, ['LowValues', Value, 0, DimCount]);
    FLowValues[I] := Value;
    if FHighValues[I] < FLowValues[I] then
      FHighValues[I] := FLowValues[I];
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetMaxPopulation(const Value: Integer);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['MaxPopulation', SState[FState]]);
    if Value<2 then
      raise EGeneError.CreateFmt(SInvalidParam, ['MaxPopulation', SLess2, Value]);
    FMaxPopulation := Value;
    if FMinPopulation >= FMaxPopulation then FMinPopulation := FMaxPopulation - 1;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetMinPopulation(const Value: Integer);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['MinPopulation', SState[FState]]);
    if Value<=0 then
      raise EGeneError.CreateFmt(SInvalidParam, ['MinPopulation', SNonPositive, Value]);
    FMinPopulation := Value;
    if FMinPopulation >= FMaxPopulation then FMaxPopulation := FMinPopulation + 1;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetMutation(const Value: Extended);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['Crossover', SState[FState]]);
    if (Value<0) or (Value>1) then
      raise EGeneError.CreateFmt(SInvalidProbality, ['мутации', Value]);
    FMutation := Value;
    if FCrossover + FMutation > 1.0 then
    begin
      FCrossover := 1.0 - FMutation;
      FInversion := 0.0;
    end
    else begin
      FInversion := 1.0 - FMutation - FCrossover;
    end;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetOnBestChange(const Value: TBestChangeEvent);
begin
  Lock;
  try
    FOnBestChange := Value;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetOnEstimate(const Value: TEstimateEvent);
begin
  Lock;
  try
    if FState <> gsTune then
      raise EGeneError.CreateFmt(SCannotSetParam, ['OnEstimate', SState[FState]]);
    FOnEstimate := Value;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SetOnIteration(const Value: TIterationEvent);
begin
  Lock;
  try
    FOnIteration := Value;
  finally
    Unlock;
  end;
end;
 
procedure TGeneAlgorithm.SortPopulation;
 
procedure QuickSort(L, R: Integer);
var
  I, J: Integer;
  P: Extended;
  T: TGeneRecord;
begin
  repeat
    I := L;
    J := R;
    P := FData[(L + R) shr 1].Estimate;
    repeat
      while FData[I].Estimate > P do
        Inc(I);
      while FData[J].Estimate < P do
        Dec(J);
      if I <= J then
      begin
        if (I=0) or (J=0) then Lock;
        try
          T := FData[I];
          FData[I] := FData[J];
          FData[J] := T;
        finally
          if (I=0) or (J=0) then UnLock;
        end;
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then
      QuickSort(L, J);
    L := I;
  until I >= R;
end;
 
begin
  QuickSort(0, Length(FData) - 1);
end;
 
procedure TGeneAlgorithm.Suspend;
begin
  if FState<>gsExecute then
    raise EGeneError.Create('Прежде чем остановить, надо запустить!');
  FSolutionThread.Terminate;
// FSolutionThread.WaitFor;
  FState := gsSuspend;
end;
 
procedure TGeneAlgorithm.Unlock;
begin
  LeaveCriticalSection(FLock);
end;
 
{ TSolutionThread }
 
constructor TSolutionThread.Create(AOwner: TGeneAlgorithm);
begin
  FOwner := AOwner;
  FreeOnTerminate := True;
  inherited Create(False);
end;
 
procedure TSolutionThread.Execute;
begin
  repeat
    Owner.MakeChild;
    Owner.EstimatePopulation(Owner.FMinPopulation);
    Owner.SortPopulation;
    Inc(Owner.FIteration);
  until Terminated;
  Sleep(10);
end;
 
end. 

Пример использования:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Genes, ExtCtrls, Grids;
 
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit4: TEdit;
    Button4: TButton;
    Button5: TButton;
    Timer1: TTimer;
    Button7: TButton;
    Label1: TLabel;
    Grid: TStringGrid;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure Refresh;
    procedure GeneEstimate(Sender: TObject; const X: TExtendedArray; var Y: Extended);
  public
    FGene: TGeneAlgorithm;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.DFM}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  DecimalSeparator := '.';
  FGene := TGeneAlgorithm.Create;
  Refresh;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FGene.Free;
end;
 
procedure TForm1.Refresh;
begin
  Edit1.Text := FloaTtoStr(FGene.Crossover);
  Edit2.Text := FloatToStr(FGene.Mutation);
  Edit3.Text := FloatToStr(FGene.Inversion);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  FGene.Crossover := StrTofloat(Edit1.Text);
  Refresh;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  FGene.Mutation := StrTofloat(Edit2.Text);
  Refresh;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  FGene.Inversion := StrTofloat(Edit3.Text);
  Refresh;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
begin
  FGene.BitPerNumber := StrToInt(Edit4.Text);
  Edit4.Text := IntToStr(FGene.BitPerNumber);
end;
 
procedure TForm1.Button5Click(Sender: TObject);
var I: Integer;
begin
  Randomize;
  FGene.DimCount := 5;
  FGene.MaxPopulation := 10000;
  FGene.MinPopulation := 5000;
  FGene.OnEstimate := GeneEstimate;
  for I:=0 to 4 do
  begin
    FGene.LowValues[I] := 0;
    FGene.HighValues[I] := 10;
  end;
  FGene.Run;
  Timer1.Enabled := True;
end;
 
procedure TForm1.GeneEstimate(Sender: TObject; const X: TExtendedArray;
  var Y: Extended);
var I: Integer;
begin
  Y := 0;
  for I:=Low(X) to High(X) do
    Y := Y + Sqr(X[I]-I);
  Y := -Y; 
end;
 
procedure TForm1.Button7Click(Sender: TObject);
var I: Integer;
begin
  Timer1.Enabled := False;
  Label1.Caption := '';
  FGene.Suspend;
  Grid.RowCount := FGene.DimCount + 1;
  for I:=0 to FGene.DimCount-1 do
    Grid.Cells[0,I+1] := FloattoStr(FGene.BestX[I]);
  FGene.Abort;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Caption := FloatToStr(FGene.BestEstimate);
end;
 
end.