art神经网络的delphi实现.txt

这是一个用Delphi写的ART神经网络源码

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.