bptrainunit.pas

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

    if Newex>min_ex then
      trainresult.Caption :=format('训练失败!迭代了%d次'+#13'平均误差为%.4f',[IteriationTimes,NewEx]);
    //释放内存空间
    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 TBPTrainForm.GetBPInput(): D2Array;
begin

end;

// 进行识别，并将识别结果写出
procedure TBPTrainForm.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];//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.50 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]);
  //根据输出结果进行识别
  //显示识别产生的输出码
  resultlabel.Caption :=' -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';

   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 TBPTrainForm.Dpn1: double;
begin
  Randomize;
  result:=((Random*2.0)-1.0);
end;

function TBPTrainForm.r_num(n: D1Num; name: Pchar): boolean;
var
  buffer:D1Num;
  s:TStringList;
  i:integer;
  Pathstring:string; 
begin
  s:=TStringList.Create ;
  setlength(buffer,3);
  Pathstring:=ExtractFilePath(Application.ExeName)+'\NetWeightParameter\' ;
  s.LoadFromFile(Pathstring+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 TBPTrainForm.Rcode(AImg: TImage; imagewidth,
  imageHeight: integer): D1Array;
var
  i,j,k,idx:integer;
  w,h:integer;
  s:D2Array;
  Data:D1Array;
  max:double;
  rect:Trect;
  E:WideString;
  t:string;
  //////////////////////////////////////////////
  smin,smax:integer;
  minarray,maxarray,ytemp:array of integer;
  temp,temp2:array of array of integer;
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
   if RecognizeCharInPicture=false then
      charimage.Canvas.TextOut(0, 0, E[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]:=1.0
          else
             Data[j*imagewidth+i]:=0.01;
          end;
      end;
  end;
////////////////////////////////////////////////////////////////////////////////
{   smin:=0;
   smax:=0;
   setlength(minarray,imageHeight);
   setlength(maxarray,imageHeight);
   setlength(ytemp,imageHeight);
   for j:=0 to imageHeight-1 do
   begin
      for i:=0 to imageWidth-1 do
      begin
         if Data[j*imagewidth+i]<=0.2 then
         begin
            if i=minarray[j] then inc(minarray[j]);
         end;
      end;

      if minarray[j]=imageWidth then Continue;

      for i:=imageWidth-1 downto 0 do
      begin
         if Data[j*imagewidth+i]<=0.2 then
         begin
            if i+1=imageWidth-maxarray[j] then inc(maxarray[j]);
         end;
      end;

   end;

   for i:=0 to imageHeight-1 do ytemp[i]:=minarray[i];

   selectionsort(minarray);
   selectionsort(maxarray);
   smin:=minarray[0];
   i:=-1;
   repeat
     inc(i);
     smax:=maxarray[i];
   until(smax<>0);

   BPtrainform.Caption:=inttostr(smin)+' '+inttostr(imageWidth-1-smax);    }
////////////////////////////////////////////////////////////////////////////////

  for j:=0 to imageHeight-1 do
  begin
//     if ytemp[j]=imagewidth then continue;
     t:=' ';
     for i:=0 to imageWidth-1 do
     begin
        if  Data[j*16+i]>=0.8 then
        begin
            t:= t+'1'+' ';
        end;
        if  (Data[j*16+i]<=0.2) then
        begin
            t:= t+'0'+' ';
        end;
     end;
     memo1.Lines.Add(t);
  end;

  result:=Data;
end;

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


function TBPTrainForm.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 TBPTrainForm.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 TBPTrainForm.r_weight(var w: D2Array; n1, n2: integer;
  name: Pchar): boolean;  //读取权值
var
  i,j:integer;
  buffer:D1Array;
  s:TStringList;
  Pathstring:string;
begin
  setlength(buffer,(n1+1)*(n2+1));
  setlength(w,(n1+1),(n2+1));
  s:=TStringList.Create ;
  Pathstring:=ExtractFilePath(Application.ExeName)+'\NetWeightParameter\' ;
  s.LoadFromFile(Pathstring+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 TBPTrainForm.w_weight(var w: D2Array; n1, n2: integer; name: Pchar);
var
  i,j:integer;
  s:TstringList;
  buffer:D1Array;
  Pathstring:string;
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;
   Pathstring:=ExtractFilePath(Application.ExeName)+'\NetWeightParameter\' ;
  s.SaveToFile(Pathstring+name);
end;

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

procedure TBPTrainForm.RecognizeInPictureClick(Sender: TObject);
begin
RecognizeCharInPicture:=true;
 if OpenDialog1.Execute  then
  begin
    CharImage.Picture.Bitmap.LoadFromFile(OpenDialog1.FileName);
  end;
  RecognizeChar(Sender);
 end;
procedure TBPTrainForm.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..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
  E:=CharEdit.text;
  digitalcount:=length(E);
  momentum:=strtofloat(m_a.Text );