bpunit.~pas

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

          begin
          if s[i,j]/max >0.2 then
             Data[k,j*imagewidth+i]:=0.9
        else
             Data[k,j*imagewidth+i]:=0.1;
         end;
     end;
  end;
      t:='';
 for j:=0 to imageHeight-1 do
     begin
       t:=' ';
       for i:=0 to imageWidth-1 do
      begin
        if  Data[k,j*16+i]>=0.8 then
         t:= t+'1'+' ' ;
     if  (Data[k,j*16+i]<=0.2) then
         t:= t+'0'+' ' ;
      end;
      memo1.Lines.Add(t);
   end;
  end;
  result:=Data;
end;

// 进行识别，并将识别结果写出
procedure TBP.CodeRecognize(var Data_in: D1Array; n_in, n_hidden,
  n_out: integer; resultlabel: TLabel);
var
  i:integer;
  input_unites,hidden_unites,output_unites:D1Array;
  input_weights,hidden_weights:D2Array;
  output_unites8421:D1Num;
begin
  input_unites:=alloc_1d_dbl(n_in+1) ;
  hidden_unites:=alloc_1d_dbl(n_hidden+1);
  output_unites:=alloc_1d_dbl(n_out+1);
  setlength(output_unites8421,4);
  input_weights:=alloc_2d_dbl(n_in+1,n_hidden+1);
  hidden_weights:=alloc_2d_dbl(n_hidden+1,n_out+1);
  if r_weight(input_weights,n_in,n_hidden,Pchar('输入层到隐含层.txt'))
                                           =false then exit;
  if r_weight(hidden_weights,n_hidden,n_out,Pchar('隐含层到输出层.txt'))
                                     =false then  exit;
  begin
    for i:=1 to n_in do
      input_unites[i]:=data_in[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);
             for i:=1 to 4 do
          begin
            if output_unites[i]>0.55 then
                    output_unites8421[i-1]:=1
           else
                    output_unites8421[i-1]:=0;
         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]);
  //根据输出结果进行识别
  //显示识别产生的输出码
    if (output_unites8421[3]=0) and (output_unites8421[2]=0) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：0';
   if (output_unites8421[3]=1) and (output_unites8421[2]=0) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：1';
   if (output_unites8421[3]=0) and (output_unites8421[2]=1) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：2';
   if (output_unites8421[3]=1) and (output_unites8421[2]=1) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：3';
   if (output_unites8421[3]=0) and (output_unites8421[2]=0) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：4';
   if (output_unites8421[3]=1) and (output_unites8421[2]=0) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：5';
   if (output_unites8421[3]=0) and (output_unites8421[2]=1) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：6';
   if (output_unites8421[3]=1) and (output_unites8421[2]=1) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=0 ) then
        resultlabel.Caption :='识别结果为：7';
   if (output_unites8421[3]=0) and (output_unites8421[2]=0) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：8';
   if (output_unites8421[3]=1) and (output_unites8421[2]=0) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：9';
   if (output_unites8421[3]=0) and (output_unites8421[2]=1) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：湘';

   if (output_unites8421[3]=1) and (output_unites8421[2]=1) and  (output_unites8421[1]=0)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：赣';
   if (output_unites8421[3]=0) and (output_unites8421[2]=0) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：浙';
   if (output_unites8421[3]=1) and (output_unites8421[2]=0) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：A';
   if (output_unites8421[3]=0) and (output_unites8421[2]=1) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：B';
   if (output_unites8421[3]=1) and (output_unites8421[2]=1) and  (output_unites8421[1]=1)
                    and(output_unites8421[0]=1 ) then
        resultlabel.Caption :='识别结果为：C';
  setlength(input_unites,0);
  setlength(hidden_unites,0);
  setlength(output_unites,0);
  setlength(input_weights,0,0);
  setlength(hidden_weights,0,0);
end;
end;


function TBP.Dpn1: double;
begin
  Randomize;
  result:=((Random*2.0)-1.0);
end;

function TBP.r_num(n: D1Num; name: Pchar): boolean;
var
  buffer:D1Num;
  s:TStringList;
  i:integer;
begin
  s:=TStringList.Create ;
  setlength(buffer,3);
  s.LoadFromFile(name);
  for i:=0 to 2 do
  begin
    buffer[i]:=strtoint(s[i]);
    n[i]:=buffer[i];
  end;
  setlength(buffer,0);
  result:=true;
end;


function TBP.Rcode(AImg: TImage; imagewidth,
  imageHeight: integer): D1Array;
var
  i,j,k:integer;
  w,h:integer;
  s:D2Array;
  Data:D1Array;
  max:double;
  rect:Trect;
  E:WideString;
  t:string;
begin
  Randomize;
  memo1.Clear ;
  k:=0;
  img.Width:= 190;
  img.height:=220;
  setlength(s,imagewidth,imageHeight);
  setLength(data,imagewidth*imageHeight);
  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,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
          begin
          if s[i,j]/max >0.2 then
             Data[j*imagewidth+i]:=0.9
        else
             Data[j*imagewidth+i]:=0.1;
         end;
     end;
  end;
      t:='';
 for j:=0 to imageHeight-1 do
     begin
       t:=' ';
       for i:=0 to imageWidth-1 do
      begin
        if  Data[j*16+i]>=0.8 then
         t:= t+'1'+' ' ;
     if  (Data[j*16+i]<=0.2) then
         t:= t+'0'+' ' ;
      end;
      memo1.Lines.Add(t);
   end;
  result:=Data;
end;

function TBP.squash(x: double): double;
begin
  Result:=(1.0/(1.0+exp(-x)));
end;


function TBP.Statistic(const rect: Trect; img: TImage): integer;
var
  x,y:integer;
begin
  Result:=0;
  for x:=rect.Left  to rect.Right do
   for y:=rect.Top  to rect.Bottom  do
    if img.Canvas.Pixels[x,y]<>16777215 then
      inc(result);

end;

procedure TBP.w_num(n1, n2, n3: integer; name: Pchar);  //保存各层结点的数目
var
  s:TStringList;
  buffer: D1Num;
  i:integer;
begin
  s:=TStringList.Create ;
  setlength(buffer,3);
  buffer[0]:=n1;
  buffer[1]:=n2;
  buffer[2]:=n3;
  for i:=0 to 2 do
   s.Add(inttostr(buffer[i])) ;
  s.SaveToFile(name);
  s.Free;
end;
function TBP.r_weight(var w: D2Array; n1, n2: integer;
  name: Pchar): boolean;  //读取权值
var
  i,j:integer;
  buffer:D1Array;
  s:TStringList;
begin
  setlength(buffer,(n1+1)*(n2+1));
  setlength(w,(n1+1),(n2+1));
  s:=TStringList.Create ;
  s.LoadFromFile(name);
  for i:=0 to s.Count-1 do
    buffer[i]:=strtofloat(s[i]);
  for i:=0 to n1 do
    for j:=0 to n2 do
  w[i,j]:=buffer[i*(n2+1)+j];
  s.Free;
  setlength(buffer,0);
setlength(buffer,(n1+1)*(n2+1));  result:=true;
end;

procedure TBP.w_weight(var w: D2Array; n1, n2: integer; name: Pchar);
var
  i,j:integer;
  s:TstringList;
  buffer:D1Array;
begin
  s:=TStringList.Create ;
  setlength(buffer,(n1+1)*(n2+1));
  for i:=0 to n1 do
    for j:=0 to n2 do
    begin
      buffer[i*(n2+1)+j]:=w[i,j];
      s.Add(floattostr(buffer[i*(n2+1)+j]));
    end;
  s.SaveToFile(name);
end;

procedure TBP.FormCreate(Sender: TObject);
begin
    imgwidth:=180;
    imgheight:=210;
    OpenDialog1.Filter:='*.bmp|*.bmp';
end;
procedure TBP.ShowResult();
begin
        n_out0Edit.Text:=show1;
        n_out1Edit.Text:=show2;
        n_out2Edit.Text:=show3;
        n_out3Edit.Text:=show4;
end;

procedure TBP.OpenPictureClick(Sender: TObject);
begin
 if OpenDialog1.Execute  then
  begin
    Img.Picture.Bitmap.LoadFromFile(OpenDialog1.FileName);
  end;
end;

procedure TBP.FeatureButtonClick(Sender: TObject);
begin
//
 end;


procedure TBP.trainButtonClick(Sender: TObject);
var
  momentum,min_ex,eta:double;
  n_hidden,digitalcount:integer;
  data_in,data_out:D2Array;
  i,j:integer;
  E:WideString;
const
  A:array[0..15] of array[0..3] of double=((0.1,0.1,0.1,0.1),(0.1,0.1,0.1,0.9),
    (0.1,0.1,0.9,0.1),(0.1,0.1,0.9,0.9),(0.1,0.9,0.1,0.1),(0.1,0.9,0.1,0.9),
    (0.1,0.9,0.9,0.1),(0.1,0.9,0.9,0.9),(0.9,0.1,0.1,0.1),(0.9,0.1,0.1,0.9),
    (0.9,0.1,0.9,0.1),(0.9,0.1,0.9,0.9),(0.9,0.9,0.1,0.1),(0.9,0.9,0.1,0.9),
    (0.9,0.9,0.9,0.1),(0.9,0.9,0.9,0.9));
  n_in:integer=320;
begin
  E:=CharEdit.text;
  digitalcount:=length(E);
  momentum:=strtofloat(m_a.Text );
  min_ex:=strtofloat(m_ex.Text );
  eta:=strtofloat(m_eta.Text );
  n_hidden:=strtoint(m_hn.Text );
  setlength(data_in,16,20);
  setlength(data_out,digitalcount,4);
  data_in:=code(Img,digitalcount,16,20 );
     for i:=0 to digitalcount-1 do //输出节点值赋值
        for j:=0 to 3 do
          data_out[i,j]:=A[i,j];
   //训练BP网络
  BPTrain(Data_in, Data_out, n_in, n_hidden,min_ex, momentum, eta, digitalcount);
end;
procedure TBP.RecognizeButtonClick(Sender: TObject);
var
  n:D1Num;
  n_in,n_hidden,n_out:integer;
  i,j,w,h,x0,y0:integer;
  data:D1Array;
  //data_in:D1Array;
  E:WideString;
begin
   img.Width:= 190;
   img.height:=220;
   E:=RecognizeEdit.Text;
   charimage.Canvas.Font.Color := clBlack;
   charimage.Canvas.Font.Size :=36;
   if E<> '' then
    begin
      for w:=0 to img.Width-1 do
       for H:=0 to img.Height-1 do
     img.Canvas.Pixels[w,h]:=clWhite;
     charimage.Canvas.TextOut(0, 0, E[1]+'    ') ;
     x0:=Random(2);       y0:=Random(2);
       for w:=0 to charimage.Width-1 do
       for H:=0 to charimage.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[x0+w*4+i+Random(3),y0+h*4+j+Random(2)]:=clBlack;
      end;
        end;
    for i:=1 to 500  do
       img.Canvas.Pixels[ Random(img.Width-1 ), Random(img.Height-1)]:=clBlack;
end;
  setlength(data,16*20);
  setlength(n,3);
  if r_num(n,Pchar('各层结点数.txt'))=false then exit
  else
    n_in:=n[0];  //获取输入层结点数目
    n_hidden:=n[1];  //获取隐含层数目
    n_out:=n[2];//获取输出层数目
    data:= rcode(Img,16,20);
   //根据特征进行样本识别
    CodeRecognize(Data,n_in, n_hidden,n_out,resultlabel);
    end;
end.