Генетические алгоритмы
Автор: Mystic
WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Генетические алгоритмы
Класс, реализующий генетический алгоритм.
Зависимости: 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 .
Если Вас заинтересовала или понравилась информация по разработке на Delph - "Генетические алгоритмы", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:
Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи , в сообщение обязательно указывайте название или ссылку на статью!