unit1.~pas

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

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, janColorButton, GradBtn, StdCtrls, ExtCtrls, DB,
  DBTables;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    GroupBox7: TGroupBox;
    GroupBox8: TGroupBox;
    GroupBox9: TGroupBox;
    GroupBox10: TGroupBox;
    GroupBox11: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Edit6: TEdit;
    Edit7: TEdit;
    Edit8: TEdit;
    Edit9: TEdit;
    Edit10: TEdit;
    Edit11: TEdit;
    Edit12: TEdit;
    Edit13: TEdit;
    Edit14: TEdit;
    Edit15: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    GradBtn1: TGradBtn;
    GradBtn2: TGradBtn;
    GradBtn3: TGradBtn;
    janColorButton1: TjanColorButton;
    janColorButton2: TjanColorButton;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Edit16: TEdit;
    Edit17: TEdit;
    Edit18: TEdit;
    Edit19: TEdit;
    Edit20: TEdit;
    Edit21: TEdit;
    Label22: TLabel;
    Button4: TButton;
    Button5: TButton;
    Label23: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    Label27: TLabel;
    Label28: TLabel;
    Edit22: TEdit;
    BitBtn1: TBitBtn;
    Query1: TQuery;
    BitBtn2: TBitBtn;
    CheckBox1: TCheckBox;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    CheckBox2: TCheckBox;
    Timer1: TTimer;
    Label29: TLabel;
    Label30: TLabel;
    Timer2: TTimer;
    Label31: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure GradBtn1Click(Sender: TObject);
    procedure GradBtn2Click(Sender: TObject);
    procedure GradBtn3Click(Sender: TObject);
    procedure janColorButton1click(Sender: TObject);
    procedure janColorButton2click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure CheckBox2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
  private
    { Private declarations }
    rhwd,jsb,glb,gb,sqj,ljw:double;
    n:integer;
    error:double;//误差
    djcs:integer;//叠加次数
    srz:array[1..18,1..6] of double;//输入值
  public
    { Public declarations }
    quan1:array[1..9,1..6] of double;//隐层1-隐层2权
    quan2:array[1..3,1..9] of double;//隐层2-输出层权
    yuzhi1:array[1..9] of double;//隐层3阈值
    yuzhi2:array[1..3] of double;//输出层阈值
    h1:array[1..18,1..9] of double;//隐层2输出
    y2:array[1..18,1..3] of double;//输出层输出
    qwz:array[1..18,1..3] of double;//期望值
  end;

var
  Form1: TForm1;
const
  et=0.015;
  epxl=0.002;
implementation

{$R *.dfm}
uses unit2;
procedure TForm1.Button2Click(Sender: TObject);
begin
edit1.clear;
edit2.Clear;
edit3.Clear;
edit4.Clear;
edit5.Clear;
edit6.Clear;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
with query1 do
begin
  close;
  sql.Clear;
  sql.Add('insert 原始数据 values(:a,:b,:c,:d,:e,:f)');
  parambyname('a').AsFloat:=strtofloat(trim(edit1.Text));
  parambyname('b').AsFloat:=strtofloat(trim(edit2.Text));
  parambyname('c').AsFloat:=strtofloat(trim(edit3.Text));
  parambyname('d').AsFloat:=strtofloat(trim(edit4.Text));
  parambyname('e').AsFloat:=strtofloat(trim(edit5.Text));
  parambyname('f').AsFloat:=strtofloat(trim(edit6.Text));
  execsql;
end;

button1.Font.Color:=clblack;
button3.Enabled:=true;
button3.Font.Color:=clred;
button1.Enabled:=false;

end;

procedure TForm1.Button3Click(Sender: TObject);
var
  zhibiao:array[0..5] of double;
begin
  zhibiao[0]:=strtofloat(edit1.Text);
  zhibiao[1]:=strtofloat(edit2.Text);
  zhibiao[2]:=strtofloat(edit3.Text);
  zhibiao[3]:=strtofloat(edit4.Text);
  zhibiao[4]:=strtofloat(edit5.Text);
  zhibiao[5]:=strtofloat(edit6.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不能为负!');
  rhwd:=zhibiao[0];
  glb :=zhibiao[1];
  jsb :=zhibiao[2];
  gb  :=zhibiao[3];
  sqj :=zhibiao[4];
  ljw :=zhibiao[5];
  edit7.Text:=format('%8.7f',[zhibiao[0]]);
  edit8.Text:=format('%8.7f',[zhibiao[1]]);
  edit9.Text:=format('%8.7f',[zhibiao[2]]);
  edit10.Text:=format('%8.7f',[zhibiao[3]]);
  edit11.Text:=format('%8.7f',[zhibiao[4]]);
  edit12.Text:=format('%8.7f',[zhibiao[5]]);

  gradbtn1.Enabled:=true;
  gradbtn1.Font.Color:=clred;
  button3.Font.Color:=clblack;
  button3.Enabled:=false;
end;

procedure TForm1.GradBtn1Click(Sender: TObject);
begin
  with query1 do
  begin
    close;
    sql.Clear;
    sql.Add('insert 模糊化数据 values(:a,:b,:c,:d,:e,:f)');
    parambyname('a').AsFloat:=rhwd;
    parambyname('b').AsFloat:=glb;
    parambyname('c').AsFloat:=jsb;
    parambyname('d').AsFloat:=gb;
    parambyname('e').AsFloat:=sqj;
    parambyname('f').AsFloat:=ljw;
    execsql;
  end;

gradbtn1.Font.Color:=clblack;
gradbtn1.Enabled:=false;

end;

procedure TForm1.GradBtn2Click(Sender: TObject);
begin
  edit7.Clear;
  edit8.Clear;
  edit9.Clear;
  edit10.Clear;
  edit11.Clear;
  edit12.Clear;
end;

procedure TForm1.GradBtn3Click(Sender: TObject);
var
  i,j:integer;
begin
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;
  label30.Caption:=floattostr(error);
  timer1.Enabled:=true;
end;

procedure TForm1.janColorButton1click(Sender: TObject);
var
  i,j:integer;
begin
 for i:=1 to 9 do
   for j:=1 to 6 do
     quan1[i,j]:=random(100)/100;

 for i:=1 to 3 do
   for j:=1 to 9 do
     quan2[i,j]:=random(500)/500;

 for i:=1 to 9 do
   yuzhi1[i]:=random(1000)/1000;

 for i:=1 to 3 do
   yuzhi2[i]:=random(300)/300;

  with query1 do
  begin
    close;
    sql.Clear;
    sql.Add('select *from 期望值');
    open;
  end;
  for i:=1 to 18 do
  begin
    for j:=1 to 3 do
      qwz[i,j]:=query1.Fields[j-1].AsFloat;
      query1.Next;
  end;

  n:=n+1;
  if n=10 then
  begin
    n:=0;
    gradbtn3.Enabled:=true;
    gradbtn3.Font.Color:=clred;
    jancolorbutton1.Enabled:=false;
  end;
end;

procedure TForm1.janColorButton2click(Sender: TObject);
begin
  edit13.Clear;
  edit14.Clear;
  edit15.Clear;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
  with query1 do
  begin
    close;
    sql.Clear;