unit1.pas

人工神经网络bp 算法是用于数学建模Alife.c 基于遗传算法的人工生命模拟源程序, 输入数据文件world GA_nn.c 基于遗传算法优化神经网络结构源程序,输入数据文件sample Patma

    sql.Add('insert 期望值 values(:a,:b,:c)');
    parambyname('a').AsFloat:=strtofloat(trim(edit13.Text));
    parambyname('b').AsFloat:=strtofloat(trim(edit14.Text));
    parambyname('c').AsFloat:=strtofloat(trim(edit15.Text));
    execsql;
  end;

button6.Font.Color:=clblack;
button6.Enabled:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  n:=0;
  error:=0;
  djcs:=0;
  timer1.Enabled:=false;
  button1.Enabled:=false;
  gradbtn1.Enabled:=false;
  button6.Enabled:=false;
  gradbtn3.Enabled:=false;
  checkbox1.Enabled:=false;
  button3.Enabled:=false;
  button4.Enabled:=false;
  button5.Enabled:=false;
  button8.Enabled:=false;
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
  with query1 do
  begin
    close;
    sql.Clear;
    if messagedlg('确实要删除原始数据库吗？若删除，则要重新输入样本后才能训练网络！',mtinformation,[mbyes,mbno],0)=mryes then
    begin
    sql.Add('delete 原始数据');
    execsql;
    exit;
    end;
    if messagedlg('确实要删除模糊化数据库吗？',mtinformation,[mbyes,mbno],0) = mryes then
    begin
    sql.Add('delete 模糊化数据');
    execsql;
    exit;
    end;
    if messagedlg('确实要删除期望值数据库吗？',mtinformation,[mbyes,mbno],0) = mryes then
    begin
    sql.Add('delete 期望值');
    execsql;
    exit;
    end;
  end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  edit1.Text:=edit16.Text;
  edit2.Text:=edit17.Text;
  edit3.Text:=edit18.Text;
  edit4.Text:=edit19.Text;
  edit5.Text:=edit20.Text;
  edit6.Text:=edit21.Text;

  button1.Enabled:=true;
  button1.Font.Color:=clred;
  button6.Enabled:=true;
  button6.Font.Color:=clred;

  button5.Font.Color:=clblack;
  button5.Enabled:=false;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  checkbox1.Enabled:=true;
  checkbox1.Font.Color:=clred;
  button4.Enabled:=false;
  button5.Enabled:=false;
end;

procedure TForm1.CheckBox2Click(Sender: TObject);
begin
  edit16.Clear;
  edit17.Clear;
  edit18.Clear;
  edit19.Clear;
  edit20.Clear;
  edit21.Clear;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  with query1 do
  begin
    close;
    sql.Clear;
    sql.Add('insert 扩展数据库 values(:a,:b,:c,:d,:e,:f,:g)');
    parambyname('a').AsFloat:=strtofloat(trim(edit16.Text));
    parambyname('b').AsFloat:=strtofloat(trim(edit17.Text));
    parambyname('c').AsFloat:=strtofloat(trim(edit18.Text));
    parambyname('d').AsFloat:=strtofloat(trim(edit19.Text));
    parambyname('e').AsFloat:=strtofloat(trim(edit20.Text));
    parambyname('f').AsFloat:=strtofloat(trim(edit21.Text));
    parambyname('g').AsString:=edit22.Text;
    execsql;
  end;
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  zhibiao:array[0..5] of single;
  shuchu1:array[1..9] of single;
  shuchu2:array[1..3] of single;
  i,j:integer;
begin
  if edit16.Text='' then
  begin
    showmessage('软化温度不能为空！');
    exit;
  end;
  if edit17.Text='' then
  begin
    showmessage('硅铝比不能为空！');
    exit;
  end;
  if edit18.Text='' then
  begin
    showmessage('碱酸比不能为空！');
    exit;
  end;
  if edit19.Text='' then
  begin
    showmessage('硅比不能为空！');
    exit;
  end;
  if edit20.Text='' then
  begin
    showmessage('实切径不能为空！');
    exit;
  end;
  if edit21.Text='' then
  begin
    showmessage('炉均温不能为空');
    exit;
  end;

  zhibiao[0]:=strtofloat(edit16.Text);
  zhibiao[1]:=strtofloat(edit17.Text);
  zhibiao[2]:=strtofloat(edit18.Text);
  zhibiao[3]:=strtofloat(edit19.Text);
  zhibiao[4]:=strtofloat(edit20.Text);
  zhibiao[5]:=strtofloat(edit21.Text);

  if (zhibiao[0]>1390) then
    zhibiao[0]:=1.00-1.00/(1+exp(-0.0906*zhibiao[0]+117.1))
  else if (zhibiao[0]>=1260) and (zhibiao[0]<=1390) then
    zhibiao[0]:= exp(-0.0256*0.0256*zhibiao[0]*zhibiao[0]-33.92*33.92+2*0.0256*33.92*zhibiao[0])
  else if (zhibiao[0]>0) and (zhibiao[0]<1260) then
    zhibiao[0]:=1.00/(1.00+exp(-0.0906*zhibiao[0]+123.0))
  else
    showmessage('t2 不能为负！');
  if(zhibiao[2]>0) and (zhibiao[2]<0.206) then
    zhibiao[2]:=1.00- 1.00/(1.00+exp(-60.71*zhibiao[2]+15.45))
  else if (zhibiao[2]>=0.206) and (zhibiao[2]<=0.4) then
    zhibiao[2]:=exp(-17.175*17.175*zhibiao[2]*zhibiao[2]-5.204*5.204+2*17.175*5.204*zhibiao[2])
  else if (zhibiao[2]>0.4) then
    zhibiao[2]:=1.00/(1.00+exp(-60.71*zhibiao[2]+21.34))
  else
    showmessage('ba不能为负！');
  if (zhibiao[1]>0) and (zhibiao[1]<1.87) then
    zhibiao[1]:=1.00 - 1.00/(1.00+exp(-17.07*zhibiao[1]+34.87))
  else if (zhibiao[1]>=1.87) and (zhibiao[1]<=2.56) then
    zhibiao[1]:=exp(-4.829*4.829*zhibiao[1]*zhibiao[1]-10.696*10.696+2*10.696*4.829*zhibiao[1])
  else if (zhibiao[1]>2.56) then
    zhibiao[1]:=1.00/(1.00+exp(-17.12*zhibiao[1]+40.88))
  else
    showmessage('sa 不能为负！');
  if (zhibiao[3]>78.8) then
    zhibiao[3]:=1.00-1.00/(1.00+exp(-92*zhibiao[3]+63.76))
  else  if (zhibiao[3]>=66.1) and (zhibiao[3]<=78.8) then
    zhibiao[3]:=exp(-26.444*26.444*zhibiao[3]*zhibiao[3]-19.195*19.195+2*26.444*19.195*zhibiao[3])
  else if  (zhibiao[3]>0) and (zhibiao[3]<66.1 ) then
    zhibiao[3]:=1.00/(1.00+exp(-81.78*zhibiao[3]+61.5))
  else
    showmessage('g 不能为负！');
  if (zhibiao[4]<=0.475) and (zhibiao[4]>0) then
    zhibiao[4]:=1.00-1.00/(1.00+exp(-104.397*zhibiao[4]+52.532))
  else if (zhibiao[4]>0.475) and (zhibiao[4]<0.5875) then
    zhibiao[4]:=exp(-(-29.6*zhibiao[4]+15.726)*(-29.6*zhibiao[4]+15.726))
  else if (zhibiao[4]>=0.5875) then
    zhibiao[4]:=1/(1.00+exp(-10.477*zhibiao[4]+5.861))
  else
    showmessage('sqj不能为负！');
  if (zhibiao[5]<=0.97) and (zhibiao[5]>0) then
    zhibiao[5]:=1.00-1/(1.00+exp(-122.667*zhibiao[5]+121.931))
  else if (zhibiao[5]>0.97) and (zhibiao[5]<1.065) then
    zhibiao[5]:=exp(-(-1.616*zhibiao[5]+1.645)*(-1.616*zhibiao[5]+1.645))
  else if (zhibiao[5]>=1.065) then
    zhibiao[5]:=1.00/(1.00+exp(-125.277*zhibiao[5]+130.684))
  else
    showmessage('ljw不能为负!');

  for i:=1 to 9 do
    for j:=1 to 6 do
      shuchu1[i]:=shuchu1[i]+zhibiao[j-1]*quan1[i,j];
  for i:=1 to 9 do
    shuchu1[i]:=2/(1.00+exp(-shuchu1[i]+yuzhi1[i]))-1;

  for i:=1 to 3 do
    for j:=1 to 9 do
      shuchu2[i]:=shuchu2[i]+shuchu1[j]*quan2[i,j];
  for i:=1 to 3 do
    shuchu2[i]:=2/(1.00+exp(-shuchu2[i]+yuzhi2[i]))-1;

  label25.Caption:=floattostr(shuchu2[1])+' %';
  label27.Caption:=floattostr(shuchu2[2])+' %';
  label28.Caption:=floattostr(shuchu2[3])+' %';

  button4.Enabled:=true;
  button8.Enabled:=true;
  button8.Font.Color:=clgreen;
  button5.Enabled:=true;
  checkbox1.Enabled:=false;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var

  i,j:integer;//中间值
  zet1:array[1..18,1..9] of double;//隐2误差
  zet2:array[1..18,1..3] of double;//输出误差

begin
  // error:=0;
//////////////////////////第一次判断
 { with query1 do   //打开数据库
  begin
    close;
    sql.Clear;
    sql.Add('select *from 模糊化数据');
    open;
  end;
  for i:=1 to 18 do
  begin

    for j:=1 to 6 do                         //取模糊化数据库数据
      srz[i,j]:=query1.Fields[j-1].AsFloat;

    for j:=1 to 6 do              //隐2输出
      begin
        h1[i,1]:=h1[i,1]+srz[i,j]*quan1[1,j];
        h1[i,2]:=h1[i,2]+srz[i,j]*quan1[2,j];
        h1[i,3]:=h1[i,3]+srz[i,j]*quan1[3,j];
        h1[i,4]:=h1[i,4]+srz[i,j]*quan1[4,j];
        h1[i,5]:=h1[i,5]+srz[i,j]*quan1[5,j];
        h1[i,6]:=h1[i,6]+srz[i,j]*quan1[6,j];
        h1[i,7]:=h1[i,7]+srz[i,j]*quan1[7,j];
        h1[i,8]:=h1[i,8]+srz[i,j]*quan1[8,j];
        h1[i,9]:=h1[i,9]+srz[i,j]*quan1[9,j];
      end;
    for j:=1 to 9 do
      h1[i,j]:=2/(1+exp(-h1[i,j]+yuzhi1[j]))-1;

    for j:=1 to 9 do     //输出层输出值
    begin
      y2[i,1]:=y2[i,1]+h1[i,j]*quan2[1,j];
      y2[i,2]:=y2[i,2]+h1[i,j]*quan2[2,j];
      y2[i,3]:=y2[i,3]+h1[i,j]*quan2[3,j];
    end;
    for j:=1 to 3 do
      y2[i,j]:=2/(1+exp(-y2[i,j]+yuzhi2[j]));

    error:=error+0.5*(qwz[i,1]-y2[i,1])+0.5*(qwz[i,2]-y2[i,2])+0.5*(qwz[i,3]-y2[i,3]); //输出总误差

      query1.Next;
  end;  }

if  abs(error) >0.455  then
begin
////////////////////////////////////////////////权值训练
error:=error-error;
for i:=1 to 18 do
begin

    for j:=1 to 3 do   //输出层误差
      zet2[i,j]:=y2[i,j]*(1-y2[i,j])*(qwz[i,j]-y2[i,j]);

    for j:=1 to 9 do //隐层误差
      zet1[i,j]:=(zet2[i,1]*quan2[1,j]+zet2[i,2]*quan2[2,j]+zet2[i,3]*quan2[3,j])*h1[i,j]*(1-h1[i,j]);

    for j:=1 to 9 do//隐2权值修改
    begin
      quan2[1,j]:=quan2[1,j]+et*zet2[i,1]*h1[i,j];
      quan2[2,j]:=quan2[2,j]+et*zet2[i,2]*h1[i,j];
      quan2[3,j]:=quan2[3,j]+et*zet2[i,3]*h1[i,j];
    end;

    for j:=1 to 6 do //隐1权值修改
    begin
      quan1[1,j]:=quan1[1,j]+et*zet1[i,1]*srz[i,j];
      quan1[2,j]:=quan1[2,j]+et*zet1[i,2]*srz[i,j];
      quan1[3,j]:=quan1[3,j]+et*zet1[i,3]*srz[i,j];
      quan1[4,j]:=quan1[4,j]+et*zet1[i,4]*srz[i,j];
      quan1[5,j]:=quan1[5,j]+et*zet1[i,5]*srz[i,j];
      quan1[6,j]:=quan1[6,j]+et*zet1[i,6]*srz[i,j];
      quan1[7,j]:=quan1[7,j]+et*zet1[i,7]*srz[i,j];
      quan1[8,j]:=quan1[8,j]+et*zet1[i,8]*srz[i,j];
      quan1[9,j]:=quan1[9,j]+et*zet1[i,9]*srz[i,j];
    end;

    for j:=1 to 3 do  //输出层阈值修改
      yuzhi2[j]:=yuzhi2[j]-et*zet2[i,j];

    for j:=1 to 9 do //隐2阈值修改
      yuzhi1[j]:=yuzhi1[j]-et*zet1[i,j];

    error:=error+0.5*(qwz[i,1]-y2[i,1])+0.5*(qwz[i,2]-y2[i,2])+0.5*(qwz[i,3]-y2[i,3]); //输出总误差

    for j:=1 to 6 do              //隐2输出
      begin
        h1[i,1]:=h1[i,1]+srz[i,j]*quan1[1,j];
        h1[i,2]:=h1[i,2]+srz[i,j]*quan1[2,j];
        h1[i,3]:=h1[i,3]+srz[i,j]*quan1[3,j];
        h1[i,4]:=h1[i,4]+srz[i,j]*quan1[4,j];
        h1[i,5]:=h1[i,5]+srz[i,j]*quan1[5,j];
        h1[i,6]:=h1[i,6]+srz[i,j]*quan1[6,j];
        h1[i,7]:=h1[i,7]+srz[i,j]*quan1[7,j];
        h1[i,8]:=h1[i,8]+srz[i,j]*quan1[8,j];
        h1[i,9]:=h1[i,9]+srz[i,j]*quan1[9,j];
      end;
    for j:=1 to 9 do
      h1[i,j]:=2/(1+exp(-h1[i,j]+yuzhi1[j]))-1;

    for j:=1 to 9 do     //输出层输出值
    begin
      y2[i,1]:=y2[i,1]+h1[i,j]*quan2[1,j];
      y2[i,2]:=y2[i,2]+h1[i,j]*quan2[2,j];
      y2[i,3]:=y2[i,3]+h1[i,j]*quan2[3,j];
    end;
    for j:=1 to 3 do
      y2[i,j]:=2/(1+exp(-y2[i,j]+yuzhi2[j]))-1;


end;
/////////////////////////////////////////////////////////////////////////
djcs:=djcs+1;
label30.Caption:=inttostr(djcs);
label31.Caption:=floattostr(error);
end
else
  begin
    //label30.Caption:=inttostr(djcs);
    with query1 do
    begin
      close;
      sql.Clear;
      sql.Add('insert linshi values(:a,:b)');
      parambyname('a').AsInteger:=djcs;
      parambyname('b').AsFloat:=error;
      execsql;
    end;
    checkbox1.Enabled:=true;
    checkbox1.Font.Color:=clred;
    gradbtn3.Enabled:=false;
    timer1.Enabled:=false;
    //form1.Close;
  end;
  //begin
  //label30.Caption:=inttostr(djcs);
  {checkbox1.Enabled:=true;
  checkbox1.Font.Color:=clred;
  gradbtn3.Enabled:=false;
  timer1.Enabled:=false;  }
  //end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  form2.Show;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
//label30.Caption:=inttostr(djcs);
end;

end.