bptrainunit.pas

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

  min_ex:=strtofloat(m_ex.Text );
  eta:=strtofloat(m_eta.Text );
  n_hidden:=strtoint(m_hn.Text );
  setlength(data_in,10,25); //10个数字，24个特征
  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 TBPTrainForm.RecognizeChar(Sender: TObject);
var
  n:D1Num;
  n_in,n_hidden,n_out:integer;
  i,j,w,h,x0,y0,SumX,SumY:integer;
  data:D1Array;
  //data_in:D1Array;
  E:WideString;
    Label NextLine;
begin
  setlength(data,25);
  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];//获取输出层数目
/////////得到垂直点直方图特征///////////////////////////////////
    for j:=1 to 8 do
      begin
      SumX:=0;
        for i:=1 to 8 do
        SumX:=SumX+EightCode[j][i];
       data[j]:= SumX;
       end;
/////////得到水平点直方图特征///////////////////////////////////

   for i:=1 to 8 do
      begin
       SumY:=0;
        for j:=1 to 8 do
        SumY:=SumY+EightCode[j][i];
       data[i+8]:= SumY;
       end;
 /////////得到8条水平线方向遇到的第一个白点特征///////////////
for j:=1 to 8 do
    begin
        for i:=1 to 8 do
        begin
        if EightCode[i][j]=1 then
       begin
        data[j+16]:=i; goto nextLine;
        end;
    end;
      nextLine:
    end;
   //根据特征进行样本识别
    CodeRecognize(Data,n_in, n_hidden,n_out,resultlabel);
    end;
procedure TBPTrainForm.patternClick(Sender: TObject);
var
  momentum,min_ex,eta:double;
  n_hidden,digitalcount:integer;
  data_in:d1array;
  data_out:D2Array;
  i,j:integer;
  E:WideString;
  k:integer;
const
  A:array[0..9] of array[0..3] of double=((0.01,0.01,0.01,0.01),(0.01,0.01,0.01,1.0),
    (0.01,0.01,1.0,0.01),(0.01,0.01,1.0,1.0),(0.01,1.0,0.01,0.01),(0.01,1.0,0.01,1.0),
    (0.01,1.0,1.0,0.01),(0.01,1.0,1.0,1.0),(1.0,0.01,0.01,0.01),(1.0,0.01,0.01,1.0));
   n_in:integer=24;
begin
  k:=strtoint(recognizeedit.Text);
  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,charimage.Width*charimage.height);
  setlength(data_out,digitalcount,4);
  data_in:=rcode(Img,charimage.width,charimage.height );
        for j:=0 to 3 do
  data_out[k,j]:=A[k,j];
end;

procedure TBPTrainForm.StandardImageClick(Sender: TObject);
var
  i,j,k,m:integer;
  w,h:integer;
  s:D2Array;
  Data:D1Array;
  max:double;
 // rect:Trect;
  E:WideString;
  t:string;
   bmp:tbitmap;
   xmin,xmax,ymin,ymax:integer;
   ps: pbytearray;
  begin
   bmp:=tbitmap.Create;
   bmp.Assign(charimage.Picture.Bitmap);
   bmp.Width:=charimage.width;
   bmp.Height:=charimage.height;
 //  xmin:=0;
 //  xmax:=0;
 //  ymin:=0;
//   ymax:=0;
//   for j:=0 to bmp.height-1 do  begin
//  ps:=bmp.ScanLine[j];
//    for i:=0 to bmp.width-1 do
//       if ps[3*i]=0 then  begin
//       if ymin=0 then begin
 //         ymin:=j;
 //         xmin:=i;
 //         end;
 //         if xmin>=i then
 //        xmin:=i;
 //        end;
 //        end;

  //       for j:=bmp.height-1 downto 0 do  begin
  //       ps:=bmp.ScanLine[j];
  //       for i:=bmp.width-1 downto 0  do
  //         if ps[3*i]=0 then  begin
  //         if ymax=0  then begin
  //           ymax:=j;
  //           xmax:=i;
  //           end;
  //           if xmax<=i then
  //           xmax:=i;
  //           end;
  //           end;
  //             stdimg.Width:=xmax-xmin;
  //           stdimg.Height:=ymax-ymin;
            // charimage.Picture.Bitmap.empty;
  //      stdimg.Canvas.CopyRect(rect(0,0,xmax-xmin,ymax-ymin),
  //        bmp.canvas,rect(xmin,ymin,xmax,ymax));
   //        edit1.Text:=inttostr(xmin)+inttostr(xmax)+ inttostr(ymin)+ inttostr(ymax);
            // label7.Caption:=inttostr(img.Height);
            //  listbox1.Items.Clear;
            // listbox1.Items.Add(inttostr(xmin));
            // listbox1.Items.Add(inttostr(xmax));
             // listbox1.Items.Add(inttostr(ymin));
            //   listbox1.Items.Add(inttostr(ymax));
             bmp.Free;
    img.Width:= 80;
  img.height:=160;
      for i:=0 to img.Width-1 do
       for j:=0 to  img.Height-1 do
      img.Canvas.Pixels[i,j]:=clWhite;
      w:=img.Width  mod charimage.width;
      charimage.Width:=charimage.Width +w;
      w:=img.Width  div charimage.width;
      h:=img.Height mod charimage.height;
      charimage.Height :=charimage.Height +h;
      h:= img.Height  div charimage.height;
      for i:=0 to charimage.Width do
       for j:=0 to charimage.Height do

    begin
      if charimage.Canvas.Pixels[i,j]=clBlack	then
      begin
      for k:=1 to w do
       for m:=1 to h do
      img.Canvas.Pixels[i*w+k,j*h+m]:=clBlack;
 //  Canvas.CopyMode := cmSrcCopy;
// img.Canvas.CopyRect(rect(0,0,190,220),charimage.canvas,rect(0,0,charimage.Width,charimage.Height));
  end;
  end;
end;

procedure TBPTrainForm.Button1Click(Sender: TObject);
var
i,j,k:integer;
  w,h:integer;
  s:array[1..8]of array[1..16] of integer;
  Data:array[1..8]of array[1..16] of real;
  max:double;
  rect:Trect;
  E:WideString;
  t:string;
begin
  memo1.Clear ;
  k:=0;
  img.Width:= 80;
  img.height:=160;
  //setlength(s,8,16);
 // setLength(data,8*16);
      max:=0;
      for i:=1 to 8 do
        for j:=1 to 16 do
          begin
          rect.Left :=10*(i-1);
          rect.Top  :=10*(j-1);
          rect.Right  :=rect.Left +10-1;
          rect.Bottom :=rect.Top +10-1;
          s[i,j]:=statistic(rect,img);
          if s[i,j]>max then
          max:=s[i,j];
          end;
     for j:=1 to 16 do
       begin
         for i:=1 to 8 do
          begin
          if s[i,j]/max >0.2 then
             Data[i,j]:=1.0
        else
             Data[i,j]:=0.01;
         end;
     end;

     t:='';
     for j:=1 to 16 do
     begin
        t:=' ';
        for i:=1 to 8 do
        begin
           if  Data[i,j]>=0.8 then
               t:= t+'1'+' ' ;
           if  (Data[i,j]<=0.2) then
               t:= t+'0'+' ' ;
        end;
        memo1.Lines.Add(t);
     end;
 // result:=Data;

end;

procedure TBpTrainForm.SelectionSort(var a: array of integer);
var
  i, j, t: integer;
begin
  for i := low(a) to high(a) - 1 do
    for j := high(a) downto i + 1 do
      if a[i] > a[j] then
      begin
        //交换值(a[i], a[j], i, j);
        t := a[i];
        a[i] := a[j];
        a[j] := t;
      end;
end;

procedure TBpTrainForm.GetRegion(Bmp: TBitmap);
var
i,j,min,max:integer;
minarray,maxarray,ytemp:array of integer;
l,r,t,b:integer;
begin
   setlength(minarray,Bmp.Height);
   setlength(maxarray,Bmp.Height);
   setlength(ytemp,Bmp.Height);
   for j:=0 to Bmp.Height-1 do
   begin
      for i:=0 to Bmp.Width-1 do
      begin
         if Bmp.Canvas.Pixels[i,j]=clwhite then
         begin
            if i=minarray[j] then inc(minarray[j]);
         end;
      end;

      if minarray[j]=Bmp.Width then Continue;

      for i:=Bmp.Width-1 downto 0 do
      begin
         if Bmp.Canvas.Pixels[i,j]=clwhite then
         begin
            if i+1=Bmp.Width-maxarray[j] then inc(maxarray[j]);
         end;
      end;
   end;
   for i:=0 to Bmp.Height-1 do ytemp[i]:=minarray[i];
   selectionsort(minarray);
   selectionsort(maxarray);
   min:=minarray[0];
   i:=-1;
   repeat
     inc(i);
     max:=maxarray[i];
   until(max<>0);
   l:=min-1;
   r:=Bmp.Width-max;  
   for i:=0 to Bmp.Height-2 do
   begin
      if ((ytemp[i]=Bmp.Width) and (ytemp[i+1]<>Bmp.Width)) then t:=i;
      if ((ytemp[i]<>Bmp.Width) and (ytemp[i+1]=Bmp.Width)) then b:=i+1;
   end;
    CreateBmp(l,r+2,t,b+2);
end;

procedure TBpTrainForm.CreateBmp(Left,Right,Top,Bottom: integer);
var
p1,p2:pbytearray;
x,y,r,g,b,n,gray:integer;
bmp:Tbitmap;
s,t:string;
begin
   bmp:=Tbitmap.Create;
   bmp.PixelFormat:=charimage.Picture.Bitmap.PixelFormat;
   bmp.Width:=Right-Left-1;
   bmp.Height:=Bottom-Top-1;
   for y:=top+1 to bottom-1 do
   begin
      for x:=left+1 to right-1 do
      begin
         if charimage.Canvas.Pixels[x,y]=clwhite then bmp.Canvas.Pixels[(x-Left-1),(y-Top-1)]:=clwhite;
         if charimage.Canvas.Pixels[x,y]=clblack then bmp.Canvas.Pixels[(x-Left-1),(y-Top-1)]:=clblack;
      end;
   end;
   image1.Picture.Bitmap.Assign(Bmp);
end;

procedure TBPTrainForm.Zoom;
var
  Mybmp: TBitmap;
begin
  self.DoubleBuffered := True;
  Mybmp := TBitmap.Create;
  Mybmp.Width := 49;
  Mybmp.Height := 57;
  NormalImage.Width := Mybmp.Width;
  NormalImage.Height := MyBmp.Height;
  SetStretchBltMode(Mybmp.Canvas.Handle, HalfTone);
  Stretchblt(Mybmp.Canvas.Handle, 0, 0, Mybmp.Width,
    Mybmp.Height, image1.Canvas.Handle, 0, 0, image1.Picture.Bitmap.Width,
    image1.Picture.Bitmap.Height,
    SRCCOPY);
  Mybmp.PixelFormat := pf24bit;
  //MyBmp.Assign(newbmp);
  NormalImage.Picture.Bitmap.Assign(MyBmp);
//  showform.ShowModal;
  MyBmp.Free;
end;

procedure TBPTrainForm.RecognizeInCharClick(Sender: TObject);
begin
  RecognizeCharInPicture:=false;
  RecognizeChar(Sender);
end;



procedure TBPTrainForm.PatternButtonClick(Sender: TObject);
var
  momentum,min_ex,eta:double;
  n_hidden,digitalcount:integer;
  data_in:d1array;
  data_out:D2Array;
  i,j:integer;
  E:WideString;
  k:integer;
const
  A:array[0..9] of array[0..3] of double=((0.01,0.01,0.01,0.01),(0.01,0.01,0.01,1.0),
    (0.01,0.01,1.0,0.01),(0.01,0.01,1.0,1.0),(0.01,1.0,0.01,0.01),(0.01,1.0,0.01,1.0),
    (0.01,1.0,1.0,0.01),(0.01,1.0,1.0,1.0),(1.0,0.01,0.01,0.01),(1.0,0.01,0.01,1.0));
    n_in:integer=16;
begin
  k:=strtoint(recognizeedit.Text);
  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,charimage.Width*charimage.height);
  setlength(data_out,digitalcount,4);
  data_in:=rcode(Img,charimage.width,charimage.height );
     //for i:=0 to digitalcount-1 do //输出节点值赋值

        for j:=0 to 3 do
          data_out[k,j]:=A[k,j];
   //训练BP网络
//  BPreTrain(Data_in, Data_out, n_in, n_hidden,min_ex, momentum, eta);

end;

end.