Генетические алгоритмы
01.01.2007
{ **** 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.