Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/AbonUnit.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.29 by h677, Sat Oct 9 02:06:22 2004 UTC revision 1.30 by yoffy, Wed Oct 20 18:24:59 2004 UTC
# Line 5  uses Line 5  uses
5      Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;      Windows,Messages, ShellAPI, SysUtils, Classes,StdCtrls,StrUtils;
6    
7  type  type
8    TIndiviAbon = record          TIndiviAbon = class( TObject )
9          Res: Integer;          private
10      option: Integer; // 0:透明 1:通常あぼーん                  FRes: Integer;
11    end;                  FOption: Integer; // 0:透明 1:通常あぼーん
12            public
13                    property Res            : Integer read FRes                     write FRes;
14                    property Option : Integer       read FOption    write FOption;
15            end;
16    
17            TIndiviAbonList = class( TList )
18            private
19                    FFilePath       : string;               //!< ファイルパス
20                    FLearned        : Integer;      //!< スパム学習済みレス No
21    
22                    function GetItem( index : Integer ) : TIndiviAbon;
23                    procedure SetItem( index : Integer; value : TIndiviAbon );
24    
25            public
26                    destructor Destroy; override;
27    
28                    property Items[ index : Integer ] : TIndiviAbon
29                            read GetItem write SetItem; default;
30                    procedure Sort; overload;
31                    procedure LoadFromFile( const filePath : string );
32                    procedure Save;
33            end;
34    
35    TAbon = class(TObject)    TAbon = class(TObject)
36    private    private
37      { Private 宣言 }                  { Private 宣言 }
38      Froot : String;                  Froot : String;
39      Flistpath : String;      Flistpath : String;
40      FNGwordpath : String;      FNGwordpath : String;
41      Ftokens : array of array of string;      Ftokens : array of array of string;
42      FAbonRes : array of TIndiviAbon;                  FAbonRes : TIndiviAbonList;
43      FAbonString : String;                  FAbonString : String;
44          FDeleterlo : Boolean; //&rlo;を削るか //追加&lro;も削る          FDeleterlo : Boolean; //&rlo;を削るか //追加&lro;も削る
45      FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか      FReplaceul :Boolean ; //<ul>タグを<br>タグに置換するか
46      FReverse : Boolean ;  //NGワードでのあぼ〜んの結果を反転させるか      FReverse : Boolean ;  //NGワードでのあぼ〜んの結果を反転させるか
# Line 28  type Line 50  type
50      FIndividualFileName : String;       //個別あぼ〜んのファイル名      FIndividualFileName : String;       //個別あぼ〜んのファイル名
51      FReturnNGwordLineNum : Boolean;     //NGワードの行数を返す。      FReturnNGwordLineNum : Boolean;     //NGワードの行数を返す。
52      FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか      FSetNGResAnchor : Boolean; //NGに該当したときに本文にそのレスへのレスアンカーをつけるかどうか
53      FDeleteSyria: Boolean;      //シリア語ブラクラ対策(&#1792~&#1871)                  FDeleteSyria: Boolean;  //シリア語ブラクラ対策(&#1792~&#1871)
54      procedure SetTokens(index: integer ; argline:String);      procedure SetTokens(index: integer ; argline:String);
55      function Getlistpath() : String;      function Getlistpath() : String;
56      procedure Setlistpath(const Value : String);      procedure Setlistpath(const Value : String);
# Line 65  type Line 87  type
87          procedure Execute(var ThreadStrings : TStringList); overload;          procedure Execute(var ThreadStrings : TStringList); overload;
88          procedure Execute(var ResString : String; ResNumber : Integer); overload;       //主にpluginからのDat To HTML 用          procedure Execute(var ResString : String; ResNumber : Integer); overload;       //主にpluginからのDat To HTML 用
89    
90            //! スパムフィルタの学習
91            procedure Learn( resList : TStringList );
92          //個別あぼ〜んしょり          //個別あぼ〜んしょり
93          procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;          procedure IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String); overload;
94          procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;          procedure IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer); overload;
# Line 87  const Line 111  const
111    
112  implementation  implementation
113    
114  uses MojuUtils;  uses MojuUtils, GikoSystem, GikoBayesian;
115    
116    function InvidiAbonListSort( item1, item2 : Pointer ) : Integer;
117    begin
118    
119            Result := TIndiviAbon( item1 ).Res - TIndiviAbon( item2 ).Res;
120    
121    end;
122    
123    destructor TIndiviAbonList.Destroy;
124    var
125            i : Integer;
126    begin
127    
128            for i := 0 to Count - 1 do
129                    if inherited Items[ i ] <> nil then
130                            TObject( inherited Items[ i ] ).Free;
131    
132            inherited;
133    
134    end;
135    
136    function TIndiviAbonList.GetItem( index : Integer ) : TIndiviAbon;
137    begin
138    
139            Result := TIndiviAbon( inherited Items[ index ] );
140    
141    end;
142    
143    procedure TIndiviAbonList.SetItem( index : Integer; value : TIndiviAbon );
144    begin
145    
146            inherited Items[ index ] := Pointer( value );
147    
148    end;
149    
150    procedure TIndiviAbonList.Sort;
151    begin
152    
153            inherited Sort( InvidiAbonListSort );
154    
155    end;
156    
157    procedure TIndiviAbonList.LoadFromFile( const filePath : string );
158    var
159            bufStringList   : TStringList;
160            bufLine                         : string;
161            i                                                       : Integer;
162            item                                    : TIndiviAbon;
163    begin
164    
165            if not FileExists( filePath ) then begin
166                    FLearned := 0;
167                    Exit;
168            end;
169    
170            FFilePath := filePath;
171            bufStringList := TStringList.Create;
172            try
173                    bufStringList.LoadFromFile( filePath );
174                    if bufStringList.Values[ 'Learned' ] <> '' then begin
175                            FLearned := StrToInt( bufStringList.Values[ 'Learned' ] );
176                            bufStringList.Delete( bufStringList.IndexOfName( 'Learned' ) );
177                    end else begin
178                            FLearned := 0;
179                    end;
180    
181                    //空行削除
182                    for i := bufStringList.Count-1 downto 0 do begin
183                            if bufStringList.Strings[i] = '' then begin
184                                    bufStringList.Delete(i);
185                            end;
186                    end;
187    
188                    //代入
189                    for i := 0 to bufStringList.Count - 1 do begin
190                            bufLine                 := Trim(bufStringList.Strings[i]);
191                            item                            := TIndiviAbon.Create;
192                            item.Res                := StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));
193                            item.option     := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));
194                            Add( item );
195                    end;
196            finally
197                    bufStringList.Free;
198            end;
199    
200    end;
201    
202    procedure TIndiviAbonList.Save;
203    var
204            bufStringList   : TStringList;
205            i                                                       : Integer;
206    begin
207    
208            bufStringList := TStringList.Create;
209            try
210                    bufStringList.Values[ 'Learned' ] := IntToStr( FLearned );
211    
212                    for i := 0 to Count - 1 do begin
213                            bufStringList.Add(
214                                    IntToStr( Items[ i ].Res ) + '-' + IntToStr( Items[ i ].Option ) );
215                    end;
216    
217                    bufStringList.SaveToFile( FFilePath );
218            finally
219                    bufStringList.Free;
220            end;
221    
222    end;
223    
224  constructor TAbon.Create;  constructor TAbon.Create;
225  begin  begin
226          // 初期化          // 初期化
227          FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';          FAbonString := '&nbsp;<>&nbsp;<>&nbsp;<>&nbsp;&nbsp;<><>';
228          SetLength(FAbonRes,1);          FAbonRes := TIndiviAbonList.Create;
         FAbonRes[0].Res := 0;  
         FAbonRes[0].option := -1;  
229    
230  end;  end;
231    
232  destructor TAbon.Destroy;  destructor TAbon.Destroy;
233  begin  begin
234            FAbonRes.Free;
235          inherited;          inherited;
236  end;  end;
237  //rootはExe\config\NGwordsフォルダ  //rootはExe\config\NGwordsフォルダ
# Line 472  begin Line 603  begin
603      end;      end;
604    
605  end;  end;
606    
607    procedure TAbon.Learn( resList : TStringList );
608    var
609            i, j                            : Integer;
610            wordCount       : TWordCount;
611            spamminess      : Extended;
612            indiviAbon      : TIndiviAbon;
613    const
614            SPAM_THRESHOLD = 0.9;
615    begin
616    
617            j := 0;
618            wordCount := TWordCount.Create;
619            try
620                    if (FAbonRes.FLearned <> 0) and (FAbonRes.Count = 0) then begin
621                            // 初めての学習かつ個別あぼ〜んありなので、旧verからの移行につき
622                            // 個別あぼ〜んを使った学習
623                            FAbonRes.Sort;
624                            for i := 0 to FAbonRes.Count - 1 do begin
625                                    while (j < resList.Count) and (j + 1 < FAbonRes[ j ].Res) do begin
626                                            wordCount.Clear;
627                                            GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
628                                            GikoSys.Bayesian.Learn( wordCount, False );
629                                            Inc( j );
630                                    end;
631                                    if j < resList.Count then begin
632                                            wordCount.Clear;
633                                            GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
634                                            GikoSys.Bayesian.Learn( wordCount, True );
635                                            Inc( j );
636                                    end;
637                            end;
638    
639                            while j < resList.Count do begin
640                                    wordCount.Clear;
641                                    GikoSys.Bayesian.CountWord( resList[ j ], wordCount );
642                                    GikoSys.Bayesian.Learn( wordCount, False );
643                                    Inc( j );
644                            end;
645                    end else begin
646                            // 旧verからの移行ではないのでレスを全て推論で学習
647                            // ※推論が間違っている場合はユーザがあぼ〜んを修正する事で学習される
648                            for j := FAbonRes.FLearned to resList.Count - 1 do begin
649                                    wordCount.Clear;
650                                    spamminess := GikoSys.Bayesian.Parse( resList[ j ], wordCount );
651                                    if spamminess >= SPAM_THRESHOLD then begin
652                                            // スパム
653                                            GikoSys.Bayesian.Learn( wordCount, True );
654                                            indiviAbon := TIndiviAbon.Create;
655                                            indiviAbon.Res := j + 1;
656                                            indiviAbon.Option := 1;
657                                            FAbonRes.Add( indiviAbon );
658                                    end else begin
659                                            // ハム
660                                            GikoSys.Bayesian.Learn( wordCount, False );
661                                    end;
662                            end;
663                    end;
664    
665                    FAbonRes.FLearned := resList.Count;
666                    FAbonRes.Save;
667            finally
668                    wordCount.Free;
669            end;
670    
671            FAbonRes.Save;
672            GikoSys.Bayesian.Save;
673    
674    end;
675    
676  //複数のNGワードテキストを読み込む=====ここまで=================================  //複数のNGワードテキストを読み込む=====ここまで=================================
677  //個別あぼ〜ん実行関数  //個別あぼ〜ん実行関数
678  procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);  procedure TAbon.IndividualAbon(var ThreadStrings : TStringList; SetResNumFile : String);
679  var  var
680          i : Integer;          i : Integer;
681  begin  begin
682            FAbonRes.FFilePath := SetResNumFile;    // Learn で保存するので
683            Learn( ThreadStrings );
684          if FileExists(SetResNumFile) = true then begin          if FileExists(SetResNumFile) = true then begin
685          if LoadFromSetResNumFile(SetResNumFile) = true then begin                  if LoadFromSetResNumFile(SetResNumFile) = true then begin
686                  for i := 0 to High(FAbonRes) do begin                          for i := 0 to FAbonRes.Count - 1 do begin
687                   if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin                                  if (FAbonRes[i].Res <= ThreadStrings.Count) and (FAbonRes[i].Res > 0) then begin
688                          if FAbonRes[i].option = 0 then begin                                          if FAbonRes[i].option = 0 then begin
689                          ThreadStrings.Strings[FAbonRes[i].Res-1] := '';                                                  ThreadStrings.Strings[FAbonRes[i].Res-1] := '';
690                      end else begin                                          end else begin
691                          ThreadStrings.Strings[FAbonRes[i].Res-1] := 'あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>';                                                  ThreadStrings.Strings[FAbonRes[i].Res-1] := 'あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>あぼ〜ん<>';
692                      end;                                          end;
693                   end;                                  end;
694                            end;
695              end;                  end;
696          end;          end else begin
697      end else begin                  FIndividualFileName := SetResNumFile;
698          FIndividualFileName := SetResNumFile;                  FAbonRes.Free;
699          SetLength(FAbonRes,1);                  FAbonRes := TIndiviAbonList.Create;
700          FAbonRes[0].Res := 0;          end;
         FAbonRes[0].option := -1;  
     end;  
701  end;  end;
702  procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);  procedure TAbon.IndividualAbon(var ResString : String; SetResNumFile : String; ResNumber : Integer);
703  var  var
# Line 504  var Line 705  var
705  begin  begin
706          if FileExists(SetResNumFile) = true then begin          if FileExists(SetResNumFile) = true then begin
707          if LoadFromSetResNumFile(SetResNumFile) = true then begin          if LoadFromSetResNumFile(SetResNumFile) = true then begin
708                  for i := 0 to High(FAbonRes) do begin                                          for i := 0 to FAbonRes.Count - 1 do begin
709                   if FAbonRes[i].Res = ResNumber then begin                   if FAbonRes[i].Res = ResNumber then begin
710                          if FAbonRes[i].option = 0 then begin                          if FAbonRes[i].option = 0 then begin
711                          ResString := '';                          ResString := '';
# Line 516  begin Line 717  begin
717              end;              end;
718          end;          end;
719      end else begin      end else begin
720          FIndividualFileName := SetResNumFile;                                  FIndividualFileName := SetResNumFile;
721          SetLength(FAbonRes,1);                                  FAbonRes.Free;
722          FAbonRes[0].Res := 0;                                  FAbonRes := TIndiviAbonList.Create;
723          FAbonRes[0].option := -1;                  end;
     end;  
724  end;  end;
725    
726  //個別あぼ〜んファイル読み込み関数  //個別あぼ〜んファイル読み込み関数
727  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;  function TAbon.LoadFromSetResNumFile(SetResNumFile : String) : Boolean;
 var  
         bufStringList : TStringList;  
     bufLine : String;  
     i : Integer;  
728  begin  begin
729      bufStringList := TStringList.Create;  
730      try          FAbonRes.Free;
731          try          FAbonRes := TIndiviAbonList.Create;
732                  bufStringList.LoadFromFile(SetResNumFile);          FAbonRes.LoadFromFile( SetResNumFile );
733              FIndividualFileName := SetResNumFile;          Result := true;
734              //空行削除  
             for i := bufStringList.Count-1 downto 0 do begin  
                         if bufStringList.Strings[i] = '' then begin  
                         bufStringList.Delete(i);  
                     end;  
             end;  
   
             //メモリ確保  
                 SetLength(FAbonRes,bufStringList.Count);  
             //代入  
             for i :=0 to bufStringList.Count - 1 do begin  
                         bufLine := Trim(bufStringList.Strings[i]);  
                     FAbonRes[i].Res :=  StrToInt(Copy(bufLine,1,AnsiPos('-',bufLine)-1));  
                 FAbonRes[i].option := StrToInt(Copy(bufLine,AnsiPos('-',bufLine)+1,1));  
             end;  
         except  
                 Result := false;  
             Exit;  
         end;  
     finally  
         bufStringList.Free;  
     end;  
     Result := true;  
735  end;  end;
736  //個別あぼ〜んファイルに追加  //個別あぼ〜んファイルに追加
737  procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);  procedure TAbon.AddIndividualAbon( ResNum : Integer ; option : Integer; SetResNumFile : String);
# Line 596  var Line 770  var
770          i : Integer;          i : Integer;
771  begin  begin
772          if FAbonRes[0].Res <> 0 then begin          if FAbonRes[0].Res <> 0 then begin
773                  for i := 0 to High(FAbonRes) do begin                  for i := 0 to FAbonRes.Count - 1 do begin
774                          if FAbonRes[i].Res = ResNum then begin                          if FAbonRes[i].Res = ResNum then begin
775                                  Result := true;                                  Result := true;
776                                  Exit;                                  Exit;

Legend:
Removed from v.1.29  
changed lines
  Added in v.1.30

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26