ART神经网络的Delphi实现

ART神经网络的Delphi实现

unit ARTUnit;

interface
  uses Windows, SysUtils, Classes, Extctrls, Math, LPR_HUnit, Dialogs;

type
   TArtNet = class(TObject)
       private
       //F1到F2的连接权
           Wb : array[0..MaxCNN - 1, 0..MaxRNN - 1] of Double;
       //F2到F1的连接权
           Wt : array[0..MaxRNN - 1, 0..MaxCNN - 1] of Integer;
           //警戒值  
           VigilThresh : Double;          
           L : Double;                    
       //识别层的神经元数
           M : Integer;                  
       //比较层的神经元数
           N : Integer;                  
           //权文件名
           FileName : string;            
           //输入向量
           XVect : array[0..MaxCNN - 1] of Integer;      
       //比较层的输出向量
           CVect : array[0..MaxCNN - 1] of Integer;      
           //最优识别层神经元
           BestNeuron : Integer;          
           Reset : Boolean;
           //识别层输出向量
           RVect : array[0..MaxRNN - 1] of Integer;      
       //识别层最优神经元到比较层的权
           PVect : array[0..MaxCNN - 1] of Integer;      
           //识别层禁止标志
           Disabled : array[0..MaxRNN - 1] of Boolean;  
       //对应识别字符
           RecoCharASCII : array[0..MaxRNN - 1] of string[2];

           procedure ClearPVect;
           procedure ClearRVect;
           procedure ClearDisabled;
       //Calc comparison by 2/3 rule
           procedure RunCompLayer;        
           function RunRecoLayer : Boolean;
           procedure RVect2PVect(best : Integer);
       //比较层增益
           function Gain1 : Integer;      
       //识别层增益
           function Gain2 : Integer;      
       //计算警戒值
           function Vigilence : Double;  
       //初始化权重
           procedure InitWeights;        
       //调整连接权
           procedure Train;              
       //保存权值
           procedure SaveWeights(CharImg : TGrayImg);        
       //加载权值
           procedure LoadWeights(CharImg : TGrayImg);        
           procedure LoadInVects(SrcCharImg : TGrayImg);
           function GetRecoChar : string;
       public
           constructor Create;
           procedure InitARTNET(VT : Double);
           function Run(CharImg : TGrayImg; var No : string) : Boolean;
   end;


//出口函数
function GetCharByCharImg(SrcCharImg : TGrayImg;
                        CharType : Integer; var No : string) : Boolean;


implementation
  uses MainUnit;
constructor TArtNet.Create;
begin
    inherited Create;
end;

procedure TArtNet.ClearPVect;
var
    i : Integer;
begin
    for  i := 0 to N - 1 do
        PVect := 0;
end;
procedure TArtNet.ClearRVect;
var
    i : Integer;
begin
    for  i := 0 to N - 1 do
        RVect := 0;
end;

procedure TArtNet.ClearDisabled;
var
    i : Integer;
begin
    for i := 0 to M - 1 do
        Disabled := False;
end;

procedure TArtNet.RunCompLayer;
var
    i, x : Integer;
begin
    for i := 0 to N - 1 do
    begin
         x := XVect + Gain1() + PVect;
         if x >= 2 then
              CVect := 1
         else
              CVect := 0;
    end;
end;

function TArtNet.RunRecoLayer : Boolean;
var
    i, j : Integer;
    Net : array[0..MaxRNN] of Double;
    NetMax : Double;
begin
    NetMax := -1;
    BestNeuron := -1;
    for j := 0 to M - 1 do
    begin
         Net[j] := 0;
         for i := 0 to N - 1 do
         begin
              Net[j] := Net[j] + Wb[i, j] * CVect;
         end;

         if (Net[j] > NetMax) and (not Disabled[j]) then
         begin
              BestNeuron := j;
              NetMax := Net[j];
         end;
    end;
    if BestNeuron = -1 then
    begin
         //新分配一个识别单元
         BestNeuron := M;
         if BestNeuron > MAXRNN - 1 then
         begin
              Result := False;
              Exit;
         end;
    end;
    RVect[BestNeuron] := 1;
    Result := True;
end;
procedure TArtNet.RVect2PVect(best : Integer);
var
    i : Integer;
begin
    for i := 0 to N - 1 do
         PVect := Wt[best, i];
end;
procedure TArtNet.InitWeights;
var
    i, j : Integer;
    b : Double;
begin
    b := L / (L - 1 + N);
    for i := 0 to N - 1 do
        for j := 0 to MaxRNN - 1 do
            Wb[i, j] := b;

    for i := 0 to N - 1 do
        for j := 0 to MaxRNN - 1 do
            Wt[j, i] := 1;
end;
procedure TArtNet.Train;
var
    i ,z : Integer;
begin
    z := 0;
    for i := 0 to N - 1 do
        Inc(z, CVect);

    for i := 0 to N - 1 do
    begin
        Wb[i, BestNeuron] := L * CVect / (L - 1 + z);
        Wt[BestNeuron, i] := CVect;
    end;
end;
procedure TArtNet.LoadInVects(SrcCharImg : TGrayImg);
var
    i, j : Integer;
begin
    for i := 0 to SrcCharImg.Height - 1 do
         for j := 0 to SrcCharImg.Width - 1 do
              XVect[i * SrcCharImg.Width + j] := SrcCharImg.Img[i, j] div

255;
end;

function TArtNet.Run(CharImg : TGrayImg; var No : string) : Boolean;
var
    S : Double;
begin
    LoadInVects(CharImg);
    LoadWeights(CharImg);
    While Reset do
    begin
         ClearRVect;
         ClearPVect;
         RunCompLayer;            //XVect => CVect
         if not RunRecoLayer then //Get BestNeuron
         begin
              Result := False;    //分类超出最大识别单元数
              Exit;
         end;
         RVect2PVect(BestNeuron); //Wt[BestNeuron,i] = >

PVect
         RunCompLayer;            //XVect * PVect => CVect
         S := Vigilence;          //Sum(CVect) / Sum(XVect)
         if S < VigilThresh then
         begin
              Reset := True;
              RVect[BestNeuron] := 0;
              Disabled[BestNeuron] := True;
         end
         else begin
              Reset := False;
              Train;
         end;
    end;
    SaveWeights(CharImg);
    No := GetRecoChar;
    Result := True;
end;

procedure TArtNet.SaveWeights(CharImg : TGrayImg);
var
    FileStream : TFileStream;
    WeightRecord : TWeightRecord;
    WeightRecordLength : Integer;
    i, k : Integer;
    TempM : Integer;
begin
    WeightRecordLength := sizeof(TWeightRecord);
    //权库文件不存在
    if FileExists(FileName) then
    begin
         //打开权文件
         FileStream := TFileStream.Create(FileName, fmOpenReadWrite);
         //如果有新分配单元，则修改文件中的M
         if BestNeuron >= M then
         begin
              TempM := M + 1;
              FileStream.WriteBuffer(TempM, sizeof(TempM));
              //索引
              WeightRecord.RecordIndex := BestNeuron;
              //权值
              for i := 0 to N - 1 do
              begin
                   WeightRecord.PWb := Wb[i, BestNeuron];
                   WeightRecord.PWt := Wt[BestNeuron, i];
              end;
              //结果
              WeightRecord.CharResult := '?';
              //该次识别对应的字符图象
              WeightRecord.CharImgWidth := CharImg.Width;
              WeightRecord.CharImgHeight := CharImg.Height;
              for i := 0 to CharImg.Height - 1 do
                   for k := 0 to CharImg.Width - 1 do
                        WeightRecord.CharImg[i * CharImg.Width + k] :=

CharImg.Img[i, k];
              //写入文件
              FileStream.Seek(BestNeuron * WeightRecordLength + sizeof(M),

soFromBeginning);
              FileStream.WriteBuffer(WeightRecord, WeightRecordLength);
         end
         else begin
              //如果不是新分配的单元，则先填充WeightRecord结构
              FileStream.Seek(BestNeuron * WeightRecordLength +

sizeof(M),0);
              FileStream.ReadBuffer(WeightRecord, WeightRecordLength);
              //修改WeightRecord结构的权值
              for i := 0 to N - 1 do
              begin
                   WeightRecord.PWb := Wb[i, BestNeuron]; //权值
                   WeightRecord.PWt := Wt[BestNeuron, i];
              end;
              //写入文件
              FileStream.Seek(BestNeuron * WeightRecordLength + sizeof(M),

soFromBeginning);
              FileStream.WriteBuffer(WeightRecord, WeightRecordLength);
         end;
         FileStream.Free;
    end;
end;
procedure TArtNet.LoadWeights(CharImg : TGrayImg);
var
    FileStream : TFileStream;
    WeightRecord : TWeightRecord;
    i, j, k : Integer;
    WeightRecordLength : LongInt;
begin
    WeightRecordLength := sizeof(TWeightRecord);
    InitWeights;
    //权库文件不存在
    if not FileExists(FileName) then
    begin
         //创建权文件
         FileStream := TFileStream.Create(FileName, fmCreate);
         //先写入识别层单元数
         FileStream.WriteBuffer(M, sizeof(M));
         //填充WeightRecord结构
         for j := 0 to M - 1 do
         begin
              WeightRecord.RecordIndex := j;     //索引
              for i := 0 to N - 1 do
              begin
                  WeightRecord.PWb := Wb[i, j]; //权值
                  WeightRecord.PWt := Wt[j, i];
              end;
              WeightRecord.CharResult := '?';  //结果
              WeightRecord.CharImgWidth := CharImg.Width;
              WeightRecord.CharImgHeight := CharImg.Height;
              for i := 0 to CharImg.Height - 1 do
                   for k := 0 to CharImg.Width - 1 do
                        WeightRecord.CharImg[i * CharImg.Width + k] :=

CharImg.Img[i, k];
              FileStream.WriteBuffer(WeightRecord, WeightRecordLength);
         end;
         FileStream.Free;
    end
    else begin
         FileStream := TFileStream.Create(FileName, fmOpenRead);
         //跳过识别层单元数
         FileStream.Seek(sizeof(M), soFromBeginning);
         for j := 0 to M - 1 do
         begin
              FileStream.ReadBuffer(WeightRecord, WeightRecordLength);
              //从文件中读入权值
              for i := 0 to N - 1 do
              begin
                   Wb[i, j] := WeightRecord.PWb;
                   Wt[j, i] := WeightRecord.PWt;
              end;
              //读入对应识别字符的ASCII
              RecoCharASCII[j] := WeightRecord.CharResult;
         end;
         FileStream.Free;
    end;
end;

function TArtNet.Gain1;
var
    i, G : Integer;
begin
    G := Gain2;
    for i := 0 to N - 1 do
    begin
         if RVect = 1 then
         begin
              Result := 0;
              Exit;
         end;
    end;
    Result := G;
end;
function TArtNet.Gain2;
var
    i : Integer;
begin
    for i := 0 to N - 1 do
    begin
         if XVect = 1 then
         begin
             Result := 1;
             Exit;
         end;
    end;
    Result := 0;
end;
function TArtNet.Vigilence : Double;
var
    i : Integer;
    S, K , D : Double;
begin
    K := 0.0;
    D := 0.0;
    for i := 0 to N - 1 do
    begin
         K := K + CVect;
         D := D + XVect;
    end;
    S := K / D;
    Result := S;
end;
procedure TArtNet.InitARTNET(VT : Double);
var
    i : Integer;
    PPath : PChar;
    FileStream : TFileStream;
begin
    L := 2.0;
    N := MaxCNN;
    PPath := AllocMem(MAX_PATH);
    GetModuleFileName(0, PPath, MAX_PATH);
    FileName := ExtractFilePath(string(PPath)) + 'Lpr.art';
    if not FileExists(FileName) then
          M := 1
    else begin
          FileStream := TFileStream.Create(FileName,fmOpenRead);
          FileStream.ReadBuffer(M,sizeof(M));
          FileStream.Free;
    end;

    Reset := True;
    VigilThresh := VT;
    ClearDisabled;
    //初始化识别字符
    for i := 0 to MaxRNN - 1 do
        RecoCharASCII := '?';
end;

function TARTNET.GetRecoChar : string;
var
    Temp : string[2];
    TempChr : Char;
begin
    Temp := RecoCharASCII[BestNeuron];
    TempChr := Temp[1];
    if Ord(TempChr) < 128 then
    begin
         Result := Temp;
    end
    else begin
         Result := '粤';
    end;
end;
function GetCharByCharImg(SrcCharImg : TGrayImg;
                                 CharType : Integer; var No : string) :

Boolean;
var
    ARTNET : TARTNET;
    TempImg : TGrayImg;
    CharASCII : Byte;
begin
    if SrcCharImg.Width / SrcCharImg.Height < 0.2 then
    begin
         No := '1';
         Result := True;
         Exit;
    end;
    if not Zoom(SrcCharImg, 15, 30,TempImg) then
    begin
         Result := False;
         Exit;
    end;
    ARTNET := TARTNET.Create;
    ARTNET.InitARTNET(0.8);
    if not ARTNET.Run(TempImg, No) then
    begin
         Result := False;
         Exit;
    end;
    Result := True;
end;

end.