oldpop[j].parent[1] := 0;
      oldpop[j].xsite := 0;
      objfunc(oldpop[j]);
    end;
  end;
end;

procedure TGA.objfunc(var critter: individual); //* 計算適應度函數值 */
var
  mask, bitpos, tp: cardinal;
  bitpow: double;
  j, k, stop: integer;
begin
  mask := 1;
  critter.varible := 0.0;
  for k := 0 to chromsize - 1 do
  begin
    if (k = (chromsize - 1)) then
      stop := lchrom - (k * (8 * sizeof(cardinal)))
    else
      stop := 8 * sizeof(cardinal);
    tp := critter.chrom[k];
    for j := 0 to stop - 1 do
    begin
      bitpos := j + (8 * sizeof(cardinal)) * k;
      if ((tp and mask) = 1) then
      begin
        bitpow := power(2.0, bitpos);
        critter.varible := critter.varible + bitpow;
      end;
      tp := tp shr 1;
    end;
  end;
  critter.varible := -1 + critter.varible * 3 / (power(2.0, lchrom) -
    1);
  critter.fitness := critter.varible * sin(critter.varible * 10 * arctan(1)
    * 4) + 2.0;
end;


function TGA.flip(prob: single): boolean; // 以一定概率產生0或1
begin
  if (randomperc <= prob) then
    result := true
  else
    result := false;
end;

function TGA.select: integer; //* 輪盤賭選擇*/
var
  sum, pick: single;
  i: integer;
begin
  pick := randomperc;
  sum := 0;
  i := 0;
  if (sumfitness <> 0) then
    while ((sum < pick) and (i < popsize)) do
    begin
      sum := sum + oldpop[i].fitness / sumfitness;
      inc(i);
    end
  else
    i := rnd(1, popsize);
  result := i - 1;
end;

function TGA.rnd(low, high: integer): integer;
  //*在整數low和high之間產生一個隨機整數*/
var
  i: integer;
begin
  if (low >= high) then
    i := low
  else
  begin
    i := trunc((randomperc * (high - low + 1)) + low);
    if (i > high) then
      i := high;
  end;
  result := i;
end;

function TGA.crossover(var parent1, parent2, child1, child2: PUnsigned): integer;
  // * 由兩個父個體交叉產生兩個子個體 * /
var
  j, jcross, k: integer;
  mask, temp: cardinal;
begin
  if (flip(pcross)) then
  begin
    jcross := rnd(1, (lchrom - 1)); // * Cross between 1 and l - 1 * /
    inc(ncross, 1);
    for k := 1 to chromsize do
    begin
      if (jcross >= (k * (8 * sizeof(cardinal)))) then
      begin
        child1[k - 1] := parent1[k - 1];
        child2[k - 1] := parent2[k - 1];
      end
      else
        if ((jcross < (k * (8 * sizeof(cardinal)))) and (jcross > ((k - 1) * (8 *
          sizeof(cardinal))))) then
        begin
          mask := 1;
          for j := 1 to jcross - 1 - ((k - 1) * (8 * sizeof(cardinal))) do
          begin
            temp := 1;
            mask := mask shr 1;
            mask := mask and temp;
          end;
          child1[k - 1] := (parent1[k - 1] and mask) or (parent2[k - 1] and (not
            mask));
          child2[k - 1] := (parent1[k - 1] and (not mask)) or (parent2[k - 1] and
            mask);
        end
        else
        begin
          child1[k - 1] := parent2[k - 1];
          child2[k - 1] := parent1[k - 1];
        end;
    end;
  end
  else
  begin
    for k := 0 to chromsize - 1 do
    begin
      child1[k] := parent1[k];
      child2[k] := parent2[k];
    end;
    jcross := 0;
  end;
  result := jcross;
end;

procedure TGA.mutation(child: PUnsigned); //*變異操作*/
var
  j, k, stop: integer;
  mask, temp: cardinal;
begin
  temp := 1;
  for k := 0 to chromsize - 1 do
  begin
    mask := 0;
    if (k = (chromsize - 1)) then
      stop := lchrom - (k * (8 * sizeof(cardinal)))
    else
      stop := 8 * sizeof(cardinal);
    for j := 0 to stop - 1 do
    begin
      if (flip(pmutation)) then
      begin
        mask := mask or (temp shl j);
        inc(nmutation, 1);
      end;
    end;
    child[k] := child[k] xor mask;
  end;
end;

procedure TGA.generation;
var
  mate1, mate2, jcross, j: integer;
begin
  j := 0;
  //*  每代運算前進行預選 */
  preselect;
  //* 選擇, 交叉, 變異 */
  repeat
      //* 挑選交叉配對 */
    mate1 := select();
    mate2 := select();
      //* 交叉和變異 */
    jcross := crossover(oldpop[mate1].chrom, oldpop[mate2].chrom, newpop[j].chrom,
      newpop[j + 1].chrom);
    mutation(newpop[j].chrom);
    mutation(newpop[j + 1].chrom);
      //* 解碼, 計算適應度 */
    objfunc(newpop[j]);
      //*記錄親子關系和交叉位置 */
    newpop[j].parent[0] := mate1 + 1;
    newpop[j].xsite := jcross;
    newpop[j].parent[1] := mate2 + 1;
    objfunc(newpop[j + 1]);
    newpop[j + 1].parent[0] := mate1 + 1;
    newpop[j + 1].xsite := jcross;
    newpop[j + 1].parent[1] := mate2 + 1;
    j := j + 2;
  until (j >= (popsize - 1));
end;

procedure TGA.preselect;
var
  j: integer;
begin
  sumfitness := 0;
  for j := 0 to popsize - 1 do
    sumfitness := sumfitness + oldpop[j].fitness;
end;

procedure TGA.Go;
begin
  gen := 0;
  while (gen < maxgen) do
  begin
      //fprintf(outfp, "\n第 %d / %d 次運行: 當前代為 %d, 共 %d 代\n", run, maxruns,
        //gen, maxgen);
      // * 產生新一代 * /
    generation;
      // * 計算新一代種群的適應度統計數據 * /
    statistics(newpop);
      // * 輸出新一代統計數據 * /
    report;

    temp := copy(oldpop);
    oldpop := copy(newpop);
    newpop := copy(temp);
    inc(gen, 1);
  end;
//  freeall();
end;

procedure TGA.repchar(ch: pchar; repcount: integer);
var
  j: integer;
begin
  for j := 1 to repcount - 1 do
    write(ch);
end;

procedure TGA.report; //* 輸出種群統計結果 */

begin
  repchar('-', 80);
  skip(1);
  if (printstrings = 1) then
  begin
    repchar(' ', ((80 - 17) div 2));
    writeln('模擬計算統計報告  ');
    write('世代數 ', gen);
    repchar(' ', (80 - 28));
    writeln('世代數 ', (gen + 1));
    write('個體  染色體編碼');
    repchar(' ', lchrom - 5);
    write('適應度    父個體 交叉位置  ');
    write('染色體編碼 ');
    repchar(' ', lchrom - 5);
    write('適應度');
    repchar('-', 80);
    skip(1);
    writepop();
    repchar('-', 80);
    skip(1);
  end;
  writeln(format('第 %d 代統計: ', [gen]));
  writeln('總交叉操作次數 = ', ncross, ' 總變異操作數 = ', nmutation);
  writeln(' 最小適應度：', min, ' 最大適應度：', max, '  平均適應度 %f', avg);
  writeln(format(' 迄今發現最佳個體 =>  所在代數： %d  ', [bestfit.generation]));
  writeln(' 適應度：  染色體：', bestfit.fitness);
  writechrom(bestfit.chrom);
  writeln(' 對應的變量值: ', bestfit.varible);
  skip(1);
  repchar('-', 80);
  skip(1);
end;

procedure TGA.writepop;
var
  pind: individual;
  j: integer;
begin
  for j := 0 to popsize - 1 do
  begin
    write(format('%3d)  ',[j + 1]));
        //* 當前代個體 */
    pind := oldpop[j];
    writechrom(pind.chrom);
    write(format('  %8f | ', [pind.fitness]));
        //* 新一代個體 */
    pind := newpop[j];
    write(format('(%2d,%2d)   %2d   ', [pind.parent[0], pind.parent[1],
      pind.xsite]));
    writechrom(pind.chrom);
    writeln(format('  %8f  ', [pind.fitness]));
  end;
end;

procedure TGA.writechrom(chrom: PUnsigned); //* 輸出染色體編碼 */
var
  j, k, stop: integer;
  mask, tmp: Cardinal;
begin
  mask := 1;
  for k := 0 to chromsize - 1 do
  begin
    tmp := chrom[k];
    if (k = (chromsize - 1)) then
      stop := lchrom - (k * (8 * sizeof(cardinal)))
    else
      stop := 8 * sizeof(cardinal);
    for j := 0 to stop - 1 do
    begin
      if (tmp and mask) = 1 then
        write('1')
      else
        write('0');
      tmp := tmp shr 1;
    end;
  end;
end;

end.