bptrainunit.pas

给出了基于神经网络的手写体数字的识别程序

unit BpTrainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Buttons;
Type
  D1Array=array of double;
type
  D2Array=array of array of double;
type
  D2Num=array of array of integer;
  D1Num=array of integer;

type
  TBPTrainForm = class(TForm)
    Img: TImage;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Label10: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    m_eta: TEdit;
    m_a: TEdit;
    m_ex: TEdit;
    m_hn: TEdit;
    CharEdit: TEdit;
    trainresult: TLabel;
    resultlabel: TLabel;
    Label9: TLabel;
    Label8: TLabel;
    target3edit: TEdit;
    target2edit: TEdit;
    target1edit: TEdit;
    target0edit: TEdit;
    n_out0Edit: TEdit;
    n_out1Edit: TEdit;
    n_out2Edit: TEdit;
    n_out3Edit: TEdit;
    RecognizeEdit: TEdit;
    Label5: TLabel;
    repeateNumEdit: TEdit;
    Label6: TLabel;
    CharImage: TImage;
    Memo2: TMemo;
    RecognizeInPicture: TButton;
    trainButton: TButton;
    StandardImage: TButton;
    Button1: TButton;
    stdimg: TImage;
    Image1: TImage;
    NormalImage: TImage;
    PatternButton: TButton;
    RecogResultLabel: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure RecognizeInPictureClick(Sender: TObject);
    procedure trainButtonClick(Sender: TObject);
    procedure RecognizeChar(Sender: TObject);
    procedure patternClick(Sender: TObject);
    procedure StandardImageClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure RecognizeInCharClick(Sender: TObject);
    procedure PatternButtonClick(Sender: TObject);
  
  private
    { Private declarations }
  public
      RecognizeCharInPicture:Boolean;
   function  Statistic(const rect:Trect;img:TImage): integer;
     //function  Drnd:double;
     function  Dpn1:double;
     function  squash(x:double):double;
     function  alloc_1d_dbl(n:integer):D1Array;
     function  alloc_2d_dbl(m,n:integer):D2Array;
     function  GetBPInput():D2Array;
     function  Rcode(AImg:TImage;imagewidth,imageHeight:integer):D1Array;
     function  r_weight(var w:D2Array;n1,n2:integer;name:Pchar):boolean;
     function  r_num(n:D1Num;name:Pchar):boolean;  { Public declarations }
      procedure bpnn_initialize{(var seed:integer)};
    procedure bpnn_randomize_weights(var w:D2Array;m,n:integer);
    procedure bpnn_zero_weights(var w:D2Array;m,n:integer);
    procedure bpnn_layerforward(var l1,l2:D1Array;var conn:D2Array;n1,n2:integer);
    procedure bpnn_output_error(var delta,target,output:D1Array;nj:integer);
    procedure bpnn_hidden_error(var delta_h:D1Array;nh:integer;var delta_o:D1Array;
                                no:integer;var who:D2Array; var hidden:D1Array);
    procedure bpnn_adjust_weights(var delta:D1Array;ndelta:integer;var ly:D1Array;
                                nly:integer;var w,oldw:D2Array;eta,momentum:double);
                                  { Public declarations }
    procedure ShowResult();
    procedure w_weight(var w: D2Array; n1, n2: integer; name: Pchar);
    procedure w_num(n1,n2,n3:integer;name:Pchar);
    procedure BPTrain(var Data_in,Data_out:D2Array;n_in,n_hidden:integer;
                      min_ex,momentum,eta:double;num:integer);
    procedure CodeRecognize(var Data_in:D1Array;
                           n_in,n_hidden,n_out:integer;resultlabel: TLabel);

    procedure SelectionSort(var a: array of integer);
    procedure GetRegion(Bmp: TBitmap);
    procedure CreateBmp(Left,Right,Top,Bottom: integer);
    procedure Zoom;

  end;

var
  BPTrainForm: TBPTrainForm;
  imgwidth,imgheight:integer;
  Aimgwidth,Aimgheight :integer;
  show1,show2,show3,show4:string;

implementation
uses main;
{$R *.dfm}

{ TBP }

function TBPTrainForm.alloc_1d_dbl(n: integer): D1Array;  //申请一维数组
var
  new1:D1Array;
begin
  setlength(new1,n);
  Result:=new1;
end;

function TBPTrainForm.alloc_2d_dbl(m, n: integer): D2Array; //申请二维数组
var
  new1:D2Array;
  i:integer;
begin
  setlength(new1,m);
  for i:=low(new1) to High(new1) do
  Setlength(new1,n);
  Result:=new1;
end;

procedure TBPTrainForm.bpnn_adjust_weights(var delta: D1Array; ndelta: integer;
  var ly: D1Array; nly: integer; var w, oldw: D2Array; eta, momentum: double);//调整权值
var
  k,j:integer;
  new_dw:double;
begin
  ly[0]:=1.0;
  setlength(delta,ndelta+1);
  setlength(ly,nly+1);
  setlength(oldw,nly+1,ndelta+1);
  setlength(w,nly+1,ndelta+1);
  for j:=1 to ndelta do
  begin
    for k:=0 to nly do
    begin
      new_dw:=eta*delta[j]*ly[k]+momentum*oldw[k,j];
      w[k,j]:=w[k,j]+new_dw;
      oldw[k,j]:=new_dw;
    end;
  end;
end;


procedure TBPTrainForm.bpnn_hidden_error(var delta_h: D1Array; nh: integer;
  var delta_o: D1Array; no: integer; var who: D2Array; var hidden: D1Array);//隐含层误差
var
  j,k:integer;
  h,sum:double;//,errsum:double;
begin
//  errsum:=0.0;
  setlength(delta_h,nh+1);
  setlength(delta_o,no+1);
  setlength(hidden,nh+1);
  setlength(who,nh+1,no+1);
  for j:=1 to nh do
  begin
    h:=hidden[j];
    sum:=0.0;
    for k:=1 to no do
    sum:= sum+delta_o[k]*who[j,k];
    delta_h[j]:=h*(1.0-h)*sum;
  end;

end;

procedure TBPTrainForm.bpnn_initialize;
begin
    Randomize;
end;
procedure TBPTrainForm.bpnn_layerforward(var l1, l2: D1Array; var conn: D2Array; n1,
  n2: integer);//前向传播
var
  sum:double;
  j,k:integer;
begin
  setlength(l1,n1+1);
  setlength(l2,n2+1);
  setlength(conn,n1+1,n2+1);
  l1[0]:=1.0;
  for j:=1 to n2 do
  begin
    sum:=0.0;
    for k:=0 to n1 do
    sum:=sum+conn[k,j]*l1[k];
    l2[j]:=squash(sum);
  end;
end;


procedure TBPTrainForm.bpnn_output_error(var delta, target, output: D1Array;
  nj: integer);   //输出误差
var
  j:integer;
  o,t:double;
begin
  setlength(delta,nj+1);
  setlength(target,nj+1);
  setlength(output,nj+1);
  for j:=1 to nj do   //循环计算delta
  begin
    o:=output[j];
    t:=target[j];
    delta[j]:=o*(1.0-o)*(t-o);
  end;
end;

//随机初始化权值
procedure TBPTrainForm.bpnn_randomize_weights(var w: D2Array; m, n: integer);
var
  i,j:integer;
begin
  setlength(w,m+1,n+1);
  for i:=0 to m do
    for j:=0 to n do
     w[i,j]:=Dpn1();
end;

procedure TBPTrainForm.bpnn_zero_weights(var w: D2Array; m, n: integer);
var
  i,j:integer;
begin
  setlength(w,m+1,n+1);
  for i:=0 to m do
    for j:=0 to n do
      w[i,j]:=0.0;
end;

procedure TBPTrainForm.BPTrain(var Data_in, Data_out: D2Array; n_in,
  n_hidden: integer; min_ex, momentum, eta: double; num: integer);
var
  i,j,k,n,IteriationTimes,TotalIteriationTimes,SumX,Sumy,n_out:integer;
  OldEx,NewEx:double;
  input_unites,hidden_unites,output_unites:D1Array;
  output_deltas,hidden_deltas,target:D1Array;
  Showoutput_unites:D2Array;
  input_weights,hidden_weights:D2Array;
  input_prev_weights,hidden_prev_weights:D2Array;
  digitalcount,EachDigitalNum,FeatureItem:integer;
  E:WideString;
  Oldeta,Neweta: double;
    Label NextLine;
begin
  OldEx:=0;NewEx:=0;
  n_out:=4;
  TotalIteriationTimes:=20000;
  Oldeta:=eta;
  Neweta:=Oldeta;
  //为各个数据结构申请内存空间
  input_unites:= alloc_1d_dbl(n_in+1);
  hidden_unites:=alloc_1d_dbl(n_hidden+1);
  output_unites:=alloc_1d_dbl(n_out+1);
  output_deltas:=alloc_1d_dbl(n_hidden+1);
  hidden_deltas:=alloc_1d_dbl(n_out+1);
  target:=alloc_1d_dbl(n_out+1);
  input_weights:=alloc_2d_dbl(n_in+1,n_hidden+1);
  hidden_weights:=alloc_2d_dbl(n_in+1,n_hidden+1);
  input_prev_weights:=alloc_2d_dbl(n_hidden+1,n_out+1);
  hidden_prev_weights:=alloc_2d_dbl(n_hidden+1,n_out+1);
  //  为产生随机序列播种
  bpnn_initialize;
  //对各种权值进行初始化
  bpnn_randomize_weights(input_weights,n_in,n_hidden);
  bpnn_randomize_weights(hidden_weights,n_hidden,n_out);
  bpnn_zero_weights(input_prev_weights,n_in,n_hidden);
  bpnn_zero_weights(hidden_prev_weights,n_hidden,n_out);
  //开始对BP网络训练，设定最大迭代次数为20000次
   E:=CharEdit.text;
   digitalcount:=length(E);
   Showoutput_unites:=alloc_2d_dbl(digitalcount+1,n_out+1,);
    bpnn_zero_weights(Showoutput_unites,digitalcount,n_out);
    for n:=1 to StrToInt(repeateNumEdit.text) do
    begin
    for IteriationTimes:=0 to TotalIteriationTimes  do
   begin
     for k:=0 to num-1 do
         for EachDigitalNum:=1 to Pattern[K].num do
    begin
/////////得到水平直方图特征//////////////////////////////////
  for j:=1 to 8 do
      begin
      SumX:=0;
        for i:=1 to 8 do
        SumX:=SumX+Pattern[K].FeatureDetail[EachDigitalNum][i][j];
       data_in[k,j]:= SumX;
       end;
/////////得到垂直直方图特征///////////////////////////////////
   for i:=1 to 8 do
      begin
       SumY:=0;
        for j:=1 to 8 do
        SumY:=SumY+Pattern[K].FeatureDetail[EachDigitalNum][i][j];
       data_in[k,i+8]:= SumY;
       end;
/////////得到8条水平线方向遇到的第一个白点特征///////////////
for i:=1 to 8 do
    begin
        for j:=1 to 8 do
        begin
        if Pattern[K].FeatureDetail[EachDigitalNum][i][j]=1 then
       begin
        data_in[k,i+16]:=j; goto nextLine;
        end;
    end;
      nextLine:
    end;
    //将样本特征向量输送到输入层
      for i:=1 to n_in do
        input_unites[i]:=data_in[k,i-1];
    // 将预定的理想输出输入到BP网络的理想输出单元
       for i:=1 to n_out do
          target[i]:=data_out[k,i-1];
     // 将数据由输入层传到隐含层
       bpnn_layerforward(input_unites,hidden_unites,input_weights,n_in,n_hidden);
    // 将隐含层的输出传到输出层
      bpnn_layerforward(hidden_unites,output_unites,hidden_weights,n_hidden,n_out);
    // 误差计算
       bpnn_output_error(output_deltas,target,output_unites,n_out);
      bpnn_hidden_error(hidden_deltas,n_hidden,output_deltas,n_out,
                         hidden_weights,hidden_unites);
    //学习率修正和权值调整
       Neweta:=Oldeta*(1-IteriationTimes/(TotalIteriationTimes+200));
       bpnn_adjust_weights(output_deltas,n_out,hidden_unites,n_hidden,
                     hidden_weights,hidden_prev_weights,Neweta,momentum);
       bpnn_adjust_weights(hidden_deltas,n_hidden,input_unites,n_in,
                    input_weights,input_prev_weights,Neweta,momentum);
         for i:=1 to n_out do
       begin
       NewEx:=NewEx+(output_unites[i]-data_out[k,i-1])*(output_unites[i]-data_out[k,i-1]);
      Showoutput_unites[k,i]:=output_unites[i]
       end;  //每个字的解
    end;//NEXT K 每个样本输入训练的次数
    NewEx:=NewEx/(num*n_out);
   // 跳出循环
    if NewEx<min_ex then
      break;
   //   if  (NewEx>(OldEx*1.04)) then  momentum:=0.001;
     //  if  (NewEx<(OldEx)) then  momentum:=0.95;
       OldEx:=NewEx;
     end; //next l,下一个循环
       memo2.Lines .add('第'+inttostr(n)+'次四个结点的输出值:');
        for i:=0 to num-1 do
        memo2.Lines.Add(inttostr(i)+'的值：'+'   '+format('%5.3f',[showoutput_unites[i,1]])+'  '+
        format('%5.3f',[showoutput_unites[i,2]])+'  '+
        format('%5.3f',[showoutput_unites[i,3]])+'  '+
        format('%5.3f',[showoutput_unites[i,4]])+'  '+#13);
       memo2.lines.add('迭代次数为：'+inttostr(IteriationTimes)+#13);

     //迭代次数控制
  //相关保存
    //输入层到隐含层的权值

  end;      //训练次数反复
        n_out0Edit.Text:=floattostr(output_unites[4]);
        n_out1Edit.Text:=floattostr(output_unites[3]);
        n_out2Edit.Text:=floattostr(output_unites[2]);
        n_out3Edit.Text:=floattostr(output_unites[1]);

    w_weight(input_weights,n_in,n_hidden,Pchar('输入层到隐含层.txt'));
    //隐含层到输出层的权值
    w_weight(hidden_weights,n_hidden,n_out,Pchar('隐含层到输出层.txt'));
    //保存各层结点的数目
    w_num(n_in,n_hidden,n_out,Pchar('各层结点数.txt'));
    if Newex<=min_ex then
      trainresult.Caption :=format('平均误差为%.4f',[NewEx]);