unit1.pas

这是一个关于遗传算法求最大值的问题

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart,
  Buttons;

type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Chart1: TChart;
    Series1: TFastLineSeries;
    Label1: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Edit4: TEdit;
    BitBtn1: TBitBtn;
    Label4: TLabel;
    Edit3: TEdit;
    Series2: TFastLineSeries;
    Series3: TFastLineSeries;
    Label5: TLabel;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);
var
pm,pc:real;
maxgen:integer;
p1:array[1..5, 1..100] of char;
f1:array[1..100] of integer;
p2:array[1..5, 1..100] of char;
i,j,t,x,f,k1,k2:integer;
c:char;
max,avg,min:integer;
size:integer;
begin
//定义概率
pm := strtofloat(edit2.Text);
pc := strtofloat(edit1.Text);
size := strtoint(edit3.Text);;
Randomize;

//初始化种群
for i := 1 to size do
  for j := 1 to 5 do
    if Random(1) > 0 then
      p1[j][i] := '1'
    else
      p1[j][i] := '0';

for i := 0 to 2 do         //画图清理
  if chart1.Series[i].count > 0 then
    for j := chart1.Series[i].count - 1 downto 0 do
      chart1.Series[i].Delete(j);

//进化
t := 0;
while t < strtoint(edit4.Text) + 1 do
begin
  f := 0;
  max := 0;
  min := 65000;
  for i := 1 to size do   //计算种群适应度
  begin
    x := 0;
    if p1[1][i] = '1' then
      x := x + 1;
    if p1[2][i] = '1' then
      x := x + 2;
    if p1[3][i] = '1' then
      x := x + 4;
    if p1[4][i] = '1' then
      x := x + 8;
    if p1[5][i] = '1' then
      x := x + 16;
    f1[i] := x*x;
    if f1[i] > max then
      max := f1[i];
    if f1[i] < min then
      min := f1[i];
    f := f + f1[i];    //总适应度
  end;
  avg := f div size;

  chart1.Series[0].AddY(max);
  chart1.Series[1].AddY(avg);
  chart1.Series[2].AddY(min);

  for i := 1 to size div 2  do  //生成新的种群
  begin
    j := Random(f);  //产生随机数1
    x := 0;
    k1 := 0;        //计数k1
    while x < j do
    begin
      k1 := k1 + 1;
      x := x + f1[k1];
    end;
    j := Random(f);  //产生随机数2
    x := 0;
    k2 := 0;        //计数k2
    while x < j do
    begin
      k2 := k2 + 1;
      x := x + f1[k2];
    end;         //选择完成；
    for j := 1 to 5 do
    begin
      p2[j][2*i - 1] := p1[j][k1];
      p2[j][2*i] := p1[j][k2];
    end;           //复制完成；
    if Random(1000)/1000 <= pc then       //交叉
    begin
      j := Random(3) + 1;      //交叉位置
      for x := 1 to j do
      begin
        c := p2[x][2*i - 1];
        p2[x][2*i - 1] := p2[x][2*i];
        p2[x][2*i] := c;
      end;
    end;
    for j :=1 to 5 do
      if Random(1000)/1000 <= pm then       //变异
         if p2[j][2*i - 1] = '1' then
            p2[j][2*i - 1] := '0'
         else
            p2[j][2*i - 1] := '1';
     for j :=1 to 5 do
      if Random(1000)/1000 <= pm then       //变异
         if p2[j][2*i] = '1' then
            p2[j][2*i] := '0'
         else
            p2[j][2*i] := '1';
  end;         //新种群生成完成
  for i := 1 to size do
    for j := 1 to 5 do
      p1[j][i] := p2[j][i];  //种群整体复制
  t := t + 1;
end;
end;

end.