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

== Класс, реализующий генетический алгоритм ==
{ **** 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.
Author: Mystic
ID: 04248
Category:Алгоритмы
Category:Математика