bpunit.~pas

基于神经网络的手写数字识别系统

unit BpUnit;

interface

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

type
  TBP = 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;
    OpenPicture: TButton;
    FeatureButton: TButton;
    trainButton: TButton;
    RecognizeButton: TButton;
    procedure FormCreate(Sender: TObject);
    procedure OpenPictureClick(Sender: TObject);
    procedure FeatureButtonClick(Sender: TObject);
    procedure trainButtonClick(Sender: TObject);
    procedure RecognizeButtonClick(Sender: TObject);
  private
    { Private declarations }
  public
   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  code(Img:TImage;num,imagewidth,imageHeight:integer):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);
  end;

var
  BP: TBP;
  imgwidth,imgheight:integer;
  Aimgwidth,Aimgheight :integer;
  show1,show2,show3,show4:string;
implementation

{$R *.dfm}

{ TBP }

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

function TBP.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 TBP.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 TBP.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 TBP.bpnn_initialize;
begin
    Randomize;
end;
procedure TBP.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 TBP.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 TBP.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 TBP.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 TBP.BPTrain(var Data_in, Data_out: D2Array; n_in,
  n_hidden: integer; min_ex, momentum, eta: double; num: integer);
var
  i,k,n,l,n_out:integer;
  ex: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:integer;
  E:WideString;
begin
  ex:=0;
  l:=0;
  n_out:=4;
  //为各个数据结构申请内存空间
  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网络训练，设定最大迭代次数为15000次
   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
   data_in:=code(Img,digitalcount,16,20 );
   for l:=0 to 15000  do
   begin
    for k:=0 to num-1 do
    begin
    //将样本特征向量输送到输入层
      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];
          target0edit.Text :=floattostr(data_out[k,n_out-1]);
          target1edit.Text :=floattostr(data_out[k,n_out-2]);
          target2edit.Text:=floattostr(data_out[k,n_out-3]);
          target3edit.Text :=floattostr(data_out[k,n_out-4]);

    // 将数据由输入层传到隐含层
       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);
    //权值调整
       bpnn_adjust_weights(output_deltas,n_out,hidden_unites,n_hidden,
                     hidden_weights,hidden_prev_weights,eta,momentum);
       bpnn_adjust_weights(hidden_deltas,n_hidden,input_unites,n_in,
                    input_weights,input_prev_weights,eta,momentum);
       //误差统计
       for i:=1 to n_out do
       begin
       ex:=ex+(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;
     ex:=ex/(num*n_out);
   // 跳出循环
    if ex<min_ex then
      break;
     end;
       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(l)+#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 ex<=min_ex then
      trainresult.Caption :=format('平均误差为%.4f',[ex]);
    if ex>min_ex then
      trainresult.Caption :=format('训练失败!迭代了%d次'+#13'平均误差为%.4f',[l,ex]);
    //释放内存空间
    setlength(input_unites,0);
    setlength(hidden_unites,0);
    setlength(output_unites,0);
    setlength(hidden_deltas,0);
    setlength(hidden_deltas,0);
    setlength(target,0);
    setlength(input_weights,0);
    setlength(hidden_weights,0);
    setlength(input_prev_weights,0);
    setlength(hidden_prev_weights,0);
end;

function TBP.code(Img: TImage; num, imagewidth,
  imageHeight: integer): D2Array;
var
  i,j,k:integer;
  w,h:integer;
  s,Data:D2Array;
  max:double;
  rect:Trect;
  E:WideString;
  t:string;
begin
  Randomize;
  memo1.Clear ;
      img.Width:= 190;
      img.height:=220;
  E:= charedit.Text;
  num:=length(E);
  setlength(s,imagewidth,imageHeight);
  setLength(data,num,imagewidth*imageHeight);
 for k:=0 to num-1 do
  begin
   charimage.Canvas.Font.Color := clBlack;
   charimage.Canvas.Font.Size :=36;
   if E <> '' then
     begin
     charimage.Canvas.TextOut(0, 0, E[k+1]+'    ') ;
        for w:=0 to img.Width-1 do
       for H:=0 to  img.Height-1 do
        img.Canvas.Pixels[w,h]:=clWhite;
       for w:=0 to charimage.Width-1 do
       for H:=0 to charimage.Height-1 do
    begin
      if charimage.Canvas.Pixels[w,h]=clBlack	then
      begin
      for i:=1 to 4 do
       for j:=1 to 4 do
      img.Canvas.Pixels[w*4+i+Random(3),h*4+j]:=clBlack;
      end;
  end;
    end;
   if img <> nil then
     begin
      img.Width:= imgwidth;
      img.height:=imgheight;
      w:=img.Width  mod imagewidth;
      img.Width:=img.Width +imagewidth-w;
      w:=img.Width  div imagewidth;
      h:=img.Height mod imageHeight;
      img.Height :=img.Height +imageHeight -h;
      h:= img.Height  div imageHeight;
      max:=0;
      for i:=1 to imagewidth-1 do
        for j:=1 to imageHeight-1  do
          begin
          rect.Left :=w*(i-1);
          rect.Top  :=h*(j-1);
          rect.Right  :=rect.Left +w-1;
          rect.Bottom :=rect.Top +h-1;
          s[i,j]:=statistic(rect,img);
          if s[i,j]>max then
          max:=s[i,j];
          end;
     for j:=0 to imageHeight-1 do
       begin
         for i:=0 to imageWidth-1 do