unit1.pas

感知机分类算法用于文献分类,基于BP神经网络的基本算法

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, Math;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Panel3: TPanel;
    Image1: TImage;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit5: TEdit;
    Label5: TLabel;
    Label2: TLabel;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    Label7: TLabel;
    Edit7: TEdit;
    Edit8: TEdit;
    Label8: TLabel;
    Label15: TLabel;
    Edit11: TEdit;
    GroupBox3: TGroupBox;
    BitBtn3: TBitBtn;
    BitBtn4: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label4: TLabel;
    Label6: TLabel;
    Label12: TLabel;
    Label9: TLabel;

    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure Main;
    procedure checkparameter;
    procedure InitParameter;
    procedure ReadSampleData;
    procedure InitialWeight;
    procedure Image1Clear;
    procedure DrawZbx;
    procedure GetFirstPoint;
    procedure GetSecondPoint;
    procedure DrawLine;
    procedure CalRealout(i: integer);
    procedure ModifyV(i: integer);
    procedure ModifyG(i: integer);
    function  GetError( ): real;
    procedure SaveWeight;
    procedure Deletehint;
    procedure OutputResult;

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

  Sample:     Integer;         //样本个数
  Maxgen:     Integer;         //限定次数
  Count :     Integer;         //次数变量
  WRadio:     real;
  GRadio:     real;
  Error :     real;
  Mode  :     Integer;

  N:          Integer;         //输入节点
  Q:          Integer;         //输出节点

  V:     array of array of real;
  dV:    array of array of real;
  G:     array of real;
  dG:    array of real;

  X:     array of array of real;
  C:     array of array of real;
  Y:     array of array of real;

  Path:  String;
  Path1: String;
  Path2: String;
  Path3: String;

  Firstx: Integer;
  Firsty: Integer;
  Secondx: Integer;
  Secondy: Integer;

  AlreadyDrawZbx: Boolean;
  ParameterIsNull:Boolean;

implementation

{$R *.DFM}

//**************************************************
//*                                                *
//*           该过程用于设置窗体大小位置           *
//*                                                *
//**************************************************
procedure TForm1.FormCreate(Sender: TObject);
begin
  Bitbtn1.Enabled := False;
  Bitbtn4.Enabled := False;
  Path := extractfilepath(application.exename)+'data\';
end;

//**************************************************
//*                                                *
//*        该过程用于设置窗体中焦点初始位置        *
//*                                                *
//**************************************************
procedure TForm1.FormActivate(Sender: TObject);
begin
  Bitbtn3.SetFocus;
end;

//**************************************************
//*                                                *
//*         该过程用于设置窗体不可改变大小         *
//*                                                *
//**************************************************
procedure TForm1.FormResize(Sender: TObject);
begin
     width:=800;
     height:=600;
end;

//**************************************************
//*                                                *
//*          学习模式应使权值文件按钮失效          *
//*                                                *
//**************************************************
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  Bitbtn4.Enabled := False;
end;

//**************************************************
//*                                                *
//*          识别模式应使权值文件按钮有效          *
//*                                                *
//**************************************************
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  Bitbtn1.Enabled := False;
  Bitbtn4.Enabled := True;
end;

//**************************************************
//*                                                *
//*             该按钮用于开始运行程序             *
//*                                                *
//**************************************************
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  If RadioButton1.Checked = True Then
  begin
     Mode := 0;
     Memo1.Hide;
     Image1.Show;
  end
  Else
  begin
     Mode := 1;
     Image1.Hide;
     Memo1.Show;
  end;
  Main;
  Memo1.Enabled := True;
end;

//**************************************************
//*                                                *
//*             该按钮用于结束程序运行             *
//*                                                *
//**************************************************
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Close;
end;

//**************************************************
//*                                                *
//*             该过程用于检查输入参数             *
//*                                                *
//**************************************************
procedure TForm1.checkparameter;
begin
  ParameterIsNull := False;
  if (Edit1.Text = '') Or (Edit2.Text = '') Or
     (Edit5.Text = '') Or (Edit7.Text = '') Or
     (Edit8.Text = '') Or (Edit11.Text = '') then
  begin
     ParameterIsNull := True;
     showmessage('输入参数不能为空!!');
     exit;
  end;
end;

//**************************************************
//*                                                *
//*             该按钮用于打开数据文件             *
//*                                                *
//**************************************************
procedure TForm1.BitBtn3Click(Sender: TObject);
Var
  pn:   Integer;
  Temp: String;
  Fname: TextFile;
begin
  checkparameter;
  if(ParameterIsNull = True) then
  begin
      exit;
  end;
  OpenDialog1.Title := '请选择一个TXT文件:';
  OpenDialog1.InitialDir := Path;
  OpenDialog1.Filter := 'Text Files(*.txt)|*.txt|All Files(*.*)|*.*';
  if OpenDialog1.Execute then
     Path1 := OpenDialog1.FileName
  else
     exit;
  pn := 0;
  AssignFile(Fname, Path1);
  Reset(Fname);
  while not Eof(Fname) do
  begin
      Readln(Fname, temp);
      If temp <> '' Then pn := pn + 1;
  end;
  CloseFile(Fname);
  Edit1.Text := inttostr(pn);
  If RadioButton1.Checked = True Then Bitbtn1.Enabled := True;
end;

//**************************************************
//*                                                *
//*             该按钮用于打开权值文件             *
//*                                                *
//**************************************************
procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  checkparameter;
  if(ParameterIsNull = True) then
  begin
      exit;
  end;
    OpenDialog1.Title := '请选择一个WGT文件:';
    OpenDialog1.InitialDir := Path;
    OpenDialog1.Filter := 'WGT Files(*.wgt)|*.wgt|All Files(*.*)|*.*';
    if OpenDialog1.Execute then
       Path2 := OpenDialog1.FileName
    else
       exit;
    Bitbtn1.Enabled := True;
end;

//**************************************************
//*                                                *
//*              该过程为主要运行过程              *
//*                                                *
//**************************************************
procedure TForm1.Main;
var
  i: integer;
begin
  checkparameter;
  if(ParameterIsNull = True) then exit;
  InitParameter;
  ReadSampleData;
  InitialWeight;
  AlreadyDrawZbx := False;
  Error := 1.0;
  If Mode = 0 Then
  begin
     Image1Clear;
     DrawZbx;
     While(Error > 0) And (Count < Maxgen) Do
     begin
          GetFirstPoint;
          for i := 0 to Sample-1 do CalRealout(i);
          for i := 0 to Sample-1 do
          begin
              ModifyV(i);
              ModifyG(i);
          end;
          Error := GetError( );
          Count := Count+1;
          GetSecondPoint;
          DrawLine;
          AlreadyDrawZbx := True;
     end;
     SaveWeight;
     showmessage('迭代次数：'+inttostr(Count)+chr(13)+'最终误差：'+floattostr(Error));
     Deletehint;
  end
  else
     begin
        for i := 0 to Sample-1 do CalRealout(i);
        Error := GetError( );
     end;
  OutputResult;
end;

//**************************************************
//*                                                *
//*           该过程用于初始化学习参数             *
//*                                                *
//**************************************************
procedure TForm1.InitParameter;
begin
   //学习参数
   Sample := strtoint(Edit1.Text);          //样本个数
   Maxgen := strtoint(Edit7.Text);          //限定次数
   Count := 0;                             //学习次数
   WRadio := strtofloat(Edit8.Text);        //权值速度
   GRadio := strtofloat(Edit11.Text);       //阈值速度
   //网络结构
   N := strtoint(Edit2.Text);               //输入层单元个数
   Q := strtoint(Edit5.Text);               //输出层单元个数

   //信号数组
   Setlength(X, Sample, N);                 //样本向量
   Setlength(C, Sample, Q);                 //期望输出
   Setlength(Y, Sample, Q);                 //希望输出

   //权值数组
   Setlength(V, N, Q);                      //隐层至输出权值
   Setlength(dV,N, Q);                      //隐层至输出权值梯度
   Setlength(G, Q);                         //输出阈值
   Setlength(dG,Q);                         //输出阈值梯度
end;

//**************************************************
//*                                                *
//*        该过程用于标准化处理输出输出数据        *
//*                                                *
//**************************************************
procedure TForm1.ReadSampleData;
var
   i: integer;
   j: integer;
   Fname: TextFile;
begin
   AssignFile(Fname, Path1);
   Reset(Fname);
   For i := 0 To Sample - 1 Do
   begin
       For j := 0 To N - 1 Do
           Read(Fname, X[i][j]);

       For j := 0 To Q - 1  Do
           Read(Fname, C[i][j]);
   end;
   CloseFile(Fname);
end;

//**************************************************
//*                                                *