找了一下,源代码还在,我用Delphi5写的,因为用了几个第三方库和我自己的库,现在没法编译,不过真有兴趣的话,很容易照着用其他语言改写一下,很小,也就1000多行代码。
我把“个体”类(TIndividual)的发育、表达、遭遇等方法都声明为抽象或虚拟方法,对价值函数的调用也是通过指针进行,所以,你只要从TIndividual派生一个子类(比如我的虫子的声明:TEvJumble = class(TEvIndividual)),并给它一个价值函数,再配置一下进化环境文件,即可开始孵育你自己的虫子了,呵呵。
下面是最核心的一段代码,实现了“种群”类的“世代交替”:
procedure TEvPopulus.Digenesize;
var
i, j, n, nPopu, nBorn, nDead: Integer;
fFav, fAch, fRep, fSur, fElm, fAge, fFert, fR: Double;
P, F: TEvIndividual;
lBabies: TEvIndividuals;
L: TStringList;
FF: TIniFile;
begin
FF := TIniFile.Create(FileName);
fFav := Individuals[0].Favorable;
Individuals.SortByFavorable;
fAch := Individuals[0].Favorable;
if fAch > fFav * 1.01 then
FF.WriteString(‘Specimens’, IntToStrN(LineageNo, 6),
Individuals[0].Genes[0].AsHex + ‘,’
+ FormatFloat(‘0.000000′, fAch));
nPopu := Individuals.Count;
fFav := 0;
i := 0;
while (i < nPopu) and (Individuals[i].Experience > 0) do
begin
fFav := fFav + Individuals[i].Favorable;
Inc(i);
end;
if i > 0 then fFav := fFav / i;
fElm := Max(0.0, (0.00001 + nPopu – Population) / (nPopu * 1.0));
fFert := Fertility * Min(3, Population / nPopu);
lBabies := TEvIndividuals.Create(False);
L := TStringList.Create;
L.Sorted := True;
L.Duplicates := dupIgnore;
fAch := 0; fAge := 0;
nDead := 0;
i := 0;
while i < Individuals.Count do
begin
P := Individuals[i];
L.Add(P.Genes[0].AsHex);
fAch := fAch + P.Favorable;
fAge := fAge + P.Experience;
if fFav > 0 then
begin
fRep := Power(P.Favorable / fFav, EOR);
fSur := Power(P.Favorable / fFav, EOS);
end else
begin
fRep := 1;
fSur := 1;
end;
P.Reproductivity := fRep;
P.Survivability := fSur;
fRep := fFert * fRep;
n := Trunc(fRep);
fR := Random;
if fR <= fRep – n then
Inc(n);
for j := 0 to n – 1 do
begin
fR := Random;
F := IndividualClass.Create;
F.Inherit(P, fR <= MutateRate);
F.Develop;
lBabies.Add(F);
end;
fR := Random;
if fR * fSur <= fElm then
begin
Individuals.Delete(i);
Inc(nDead);
end else
Inc(i);
end;
nBorn := lBabies.Count;
for i := 0 to nBorn – 1 do
Individuals.Add(lBabies[i]);
lBabies.Free;
fAge := fAge / nPopu;
Achievement := fAch / nPopu;
Variety := L.Count / nPopu;
FF.WriteString(‘Progress’, IntToStrN(LineageNo, 6),
FormatFloat(‘0.000000′, Achievement) + ‘,’
+ FormatFloat(‘0.000000′, Individuals[0].Favorable) + ‘,’
+ FormatFloat(‘0.0000′, Variety) + ‘,’
+ IntToStrN(nBorn, 6) + ‘,’
+ IntToStrN(nDead, 6) + ‘,’
+ FormatFloat(‘#0.0′, fAge));
FF.Free;
LineageNo := LineageNo + 1;
L.Free;
end;
暂无评论
发表评论