unit1.pas

遗传算法(Genetic Algorithm, GA)是近几年发展起来的一种崭新的全局优化算法

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CheckLst, Grids, ValEdit, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    GroupBox6: TGroupBox;
    Label4: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    Label1: TLabel;
    Editevolve: TEdit;
    EditPc: TEdit;
    Editaberrance: TEdit;
    Editcount: TEdit;
    Panel10: TPanel;
    GroupBox1: TGroupBox;
    RadioMax: TRadioButton;
    Radiomin: TRadioButton;
    GroupBox2: TGroupBox;
    Radioexpect: TRadioButton;
    Radioroulette: TRadioButton;
    GroupBox3: TGroupBox;
    Radiosingle: TRadioButton;
    Radiodouble: TRadioButton;
    Radioequality: TRadioButton;
    Panel6: TPanel;
    Panel7: TPanel;
    BitBtn2: TBitBtn;
    Panel11: TPanel;
    Label5: TLabel;
    BitBtn1: TBitBtn;
    Editstate: TEdit;
    Panel2: TPanel;
    Panel5: TPanel;
    Panel4: TPanel;
    Button3: TButton;
    Button1: TButton;
    Button2: TButton;
    Panel3: TPanel;
    StringGrid1: TStringGrid;
    Panel8: TPanel;
    clb: TCheckListBox;
    Panel9: TPanel;
    Panel12: TPanel;
    GroupBox4: TGroupBox;
    Memo2: TMemo;
    GroupBox5: TGroupBox;
    Label6: TLabel;
    Memo1: TMemo;
    Label11: TLabel;
    Edit1: TEdit;
    Label7: TLabel;
    Edit2: TEdit;
    Label9: TLabel;
    StringGrid3: TStringGrid;
    Label10: TLabel;
    StringGrid2: TStringGrid;
    StringGrid4: TStringGrid;
    Label8: TLabel;
    E_10: TEdit;
    Edit3: TEdit;
    StringGrid5: TStringGrid;
    procedure gy;
    procedure DT_init;
    procedure UI_init;
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
   // procedure Button3Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);//变异
   // procedure BitBtn2Click(Sender: TObject);
    procedure maxPro;//求最大值时的适应值
    procedure minPro;//求最小值时的适应值
    procedure expPro;//期望值法
    procedure roulettePro;//轮盘赌法    这里还有问题
    procedure intersectPro;//交叉
    procedure aberrancePro;
    procedure showDT(n:integer;memo1:Tmemo);
    procedure showDT1(n:integer;memo1:Tmemo);
    procedure gya;
  private
    { Private declarations }
  public
    { Public declarations }
  end;
CONST INMAX=500;
CONST OUTMAX=500;
type TSmpIns =array[1..INMAX] of real;
type TSmpOuts=array[1..OUTMAX] of real;

function trun(const number:real;const l:integer):TSmpouts;
function retrun(const a:Tsmpouts;const l:integer):real;

var
  Form1: TForm1;

implementation
uses Unit_gene;
 var  interval:array of array of real; //各个个体的每个隶属度的取值范围
      smp:array of array of array of real;   //smp记录系统随机产生的种群样本
     smp_gene:array of array of real;  //smp_gene记录经区间划分后相应隶属度的对应数值
      outs:array of real;      //outs记录适应度函数的输出值
      fit:array of real;     //fit记录适应值
      smp_c:array of real;     //smp_c为种群的复制数
       ybmm:array of array of real;
       qzmm:array of real;
       qz:array of array of real;//权值A
       o:array of integer;//等级
       resulte:array of array of array of real;
       result1:integer;
       u:array of array of integer;//等级数据
 var  gcount,count,Gn,grade:integer;      //gcount为等级数,count为个体数,Gn为进化代数,grade为隶属度
      sumf,min,max:real;
      //q,r,k,t:integer;
      input:TSmpins;
      a1,a2,output:TSmpouts;
      Pc,Pm,temp:real;//pc为交叉概率，Pm为变异概率
      c,d,c2,d2:integer;
      ymm:real;//记录最大输出值
      ys:integer;
      data:integer;
{$R *.dfm}
procedure tform1.gy;
var i,j,k:integer;
    sumf:real;
begin
    for k:=0 to count-1 do
     for i:=0 to gcount-1 do
     begin
      sumf:=0;
      for j:=0 to grade-1 do
       sumf:=sumf+smp[k][i][j];
       for j:=0 to grade-1 do
       smp[k][i][j]:=smp[k][i][j]/sumf;
     end;
end;

procedure tform1.gya;
var i,j:integer;
    sumf:real;
begin
 for i:=0 to count-1 do
  begin
  sumf:=0;
  for j:=0 to ys-1 do
   sumf:=sumf+qz[i][j];
   for j:=0 to ys-1 do
   qz[i][j]:=qz[i][j]/sumf;
  end;
end;

procedure Tform1.UI_init;
var i:integer;
begin
  StringGrid1.ColCount:=strtoint(editstate.text)+1;
  stringgrid2.ColCount:=strtoint(edit2.Text);
  StringGrid1.Cells[0,0]:='隶属度';
  //StringGrid1.Cells[1,0]:='取值下限';
  //for i:=2 to strtoint(editstate.text) do
    //StringGrid1.Cells[i,0]:='隶属度 '+inttostr(i-1)+' 上限';
  StringGrid1.ColWidths[0]:=50;
  StringGrid1.RowCount:=1;
  clb.Items.Clear;
  for i:=1 to gcount do
  begin
    clb.Items.Add('--->');
    if (StringGrid1.RowCount<>2) or (StringGrid1.Cells[0,1]<>'') then
    StringGrid1.RowCount:=StringGrid1.RowCount+1;
    StringGrid1.Cells[0,StringGrid1.RowCount-1]:=
       //       form1.Grid1.Cells[StringGrid1.RowCount-1,0];
        '等级'+inttostr(StringGrid1.RowCount-1);
  end;
  //panel5.Width:=trunc((5+1)*stringGrid1.ColWidths[1]);
end;

//等级取值范围初始化
procedure Tform1.DT_init;
var i,j:integer;
begin
  //setlength(interval,gcount,5);//'5'是基因取值的区间数加 1
  setlength(interval,gcount,strtoint(editstate.text));
  for i:=0 to gcount-1 do   //初始化bx,ax,gx
    for j:=0 to strtoint(editstate.text)-1 do
    //for j:=0 to 4 do
      interval[i][j]:=strtofloat(StringGrid1.cells[j+1,i+1]);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
StringGrid1.RowCount:=1;
  gcount:=strtoint(edit1.Text);
  bitbtn1.Click;
  UI_init;
  setlength(interval,gcount,StringGrid1.ColCount-1);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
    i,j,t,k,g,http,temo:integer;
    Gn2:integer;
    chkM,Gn1:real; flag:integer;
    temp:array of real;
    temp1:array of integer;
    sump:integer;
begin
edit3.Text:='';
//for i:=0 to strtoint(e_10.text)-1 do
//stringgrid5.cells[0,i]:='';
try
  grade:=strtoint(editstate.text);
  ys:=strtoint(edit2.Text);
  data:=strtoint(e_10.Text);
  try
    Pc:=strtofloat(editpc.Text);
    Pm:=strtofloat(Editaberrance.Text);
    Gn:=strtoint(Editevolve.Text);

  except
    showmessage('相关参数不全，请输入');
    Editevolve.SetFocus;
    exit;
  end;
  try
    count:=strtoint(editcount.Text);
  except
    randomize;
    count:=random(15)+gcount;     //如果用户不确定个体数目，系统将自动生成
    editcount.Text:=inttostr(count);
  end;
  setlength(o,data);
  setlength(u,data,ys);
  setlength(qz,count,ys);
  setlength(smp,count,gcount,grade);
  setlength(smp_gene,ys,grade);
  setlength(fit,count);
  setlength(ybmm,grade,gcount);
  setlength(qzmm,ys);
  setlength(smp_c,count);
  setlength(outs,count);
  setlength(temp,grade);
  setlength(temp1,data);
  setlength(resulte,count,data,grade);
 // setlength(result1,grade);
  DT_init;
  //button1.Click;
  for i:=0 to ys-1 do
  qz[0][i]:=strtofloat(stringgrid2.Cells[i,0]);
  for i:=0 to data-1 do
   for j:=0 to ys-1 do
    u[i][j]:=strtoint(stringgrid3.Cells[j,i]);
  for i:=0 to data-1 do
   o[i]:=strtoint(stringgrid4.Cells[0,i]);

   for t:=0 to ys-1 do
     for j:=0 to grade-1 do
      begin
       smp_gene[t][j]:=0;
       temp[j]:=0;
      end;
    max:=0;    //初始0
    sump:=0;
for g:=0 to data-1 do
  begin
   max:=0;
   for t:=0 to ys-1 do
     for j:=0 to grade-1 do
      begin
       smp_gene[t][j]:=0;
       temp[j]:=0;
      end;
   for t:=0 to ys-1 do
    for j:=0 to grade-1 do
      for i:=0 to gcount-1 do
       smp_gene[t][j]:=smp_gene[t][j]+interval[u[g][t]-1][i]*interval[i][j];
   for i:=0 to grade-1 do
    begin
      for j:=0 to ys-1 do
       temp[i]:=temp[i]+qz[0][j]*smp_gene[j][i];
       //resulte[k][g][i]:=temp[i];
      if temp[i]>max then
       begin
        max:=temp[i];
        //temo:=i+1;
       temp1[g]:=i+1;
       end;
     end;
     stringgrid5.Cells[0,g]:=inttostr(temp1[g]);
    if temp1[g]=o[g] then sump:=sump+1;
    edit3.Text:=inttostr(sump);
   end;

   //系统随机生成种群，每个个体包含5个基因，共n个个体
  randomize;

  for k:=0 to count-1 do
  begin
   for i:=0 to ys-1 do
   if (qz[0][i]-0.05>0)and(k>0) then
    qz[k][i]:=qz[0][i]-random*0.05;
      if (qz[0][i]-0.05>0) then
     qz[0][i]:=qz[0][i]-random*0.05;
  for i:=0 to gcount-1 do
   begin
      for j:=0 to grade-1 do
      // smp[i][j][k]:=random*(interval[j][grade]-interval[j][0])+interval[j][0];
       if interval[i][j]<>0 then
       smp[k][i][j]:=interval[i][j]-random*0.05 ;
  end;
  end;
 gy;
 gya;
// 根据v,g,a,b区间的数值范围重定义种群基因
 { for i:=0 to count-1 do
  begin
    for j:=0 to gcount-1 do
    begin //if j<=4then //第1～4个基因越大越好
      if clb.Checked[j]=false then
        begin
          for t:=0 to grade-1 do
            if smp[i][j]>interval[j][t] then
            smp_gene[i][j]:=strtofloat(vle.Values[vle.Keys[t+1]]);
          {if smp[i][j]<=interval[j][1] then smp_gene[i][j]:=-1.5
          else  if smp[i][j]<=interval[j][2] then smp_gene[i][j]:=-0.5
                else  if smp[i][j]<=interval[j][3] then smp_gene[i][j]:=0.5
                      else smp_gene[i][j]:=1.5;}
 {       end //第5个基因越小越好
      else
        begin
          for t:=0 to grade-1 do
            if smp[i][j]<interval[j][t] then
            smp_gene[i][j]:=strtofloat(vle.Values[vle.Keys[t+1]]);
          {if smp[i][j]>interval[j][1] then smp_gene[i][j]:=-1.5
          else if smp[i][j]>interval[j][2] then smp_gene[i][j]:=-0.5
               else if smp[i][j]>interval[j][3] then smp_gene[i][j]:=0.5
                    else smp_gene[i][j]:=1.5;}
  {      end;
    end;
  end;}

//调用BP模型，计算smp_gene[n][5]的输出，获得输出outs[n]
//把结果存入数组fit[n]
Gn1:=0; Gn2:=1;     flag:=0;
if radiomax.Checked then ymm:=0;