加法虫的源代码

找了一下,源代码还在,我用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;

 

 

相关文章

标签:
524

找了一下,源代码还在,我用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;

 

 



暂无评论

发表评论