|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Ihor Bobak 2:5020/400 22 May 2001 11:37:58
To : All
Subject : Re: Поиск набора слов в тексте с помощью конечных автоматов
--------------------------------------------------------------------------------
> Hе факт, что у него был именно автомат. С той же производительностью
> можно использовать дерево цифрового поиска "trie", описанное в
> 3-м томе Кнута. В принципе, можно сказать, что TRIE от конечного
> автомата отличается только тем, что в дереве есть терминальные
> узлы - листься, тогда как в автомате из этих терминалюных
> узлов стоят связи на ROOT - то есть КА можно рассматривать как
> закольцованное TRIE.
Так и есть: из терминальных узлов стоят связи на Root.
> Hу если все же упереться в КА, есть 3 способа построить такую
> байду:
>
> 1. По набору слов статически ручками прописать автомат и
> интерпретатор дла него.
Что вы имеете в виду под "по набору слов статически ручками"?
Это как? Меня как раз и интересует алгоритм построения автомата
по набору слов (а не по одному слову).
> 2. Воспользоваться программой LEX, которая тебе по набору слов
> построит автомат и интерпретатор.
К сожалению, не знаю, о чем идет речь. Вы не могли бы конкретизировать,
что это за программа?
> 3. Динамически создавать TRIE в памяти, а потом закольцевать его.
С этим все ясно: надо посмотреть в Кнута.
- ---
Вот эталонное (суддейское) решение, любезно предоставленное
мне после окончания олимпиады:
program Multi_Pattern_Matching;
const
InFile = 'B.DAT';
DataFile = 'Count.Dat';
OutFile = 'Count.Out';
MaxSize = 20;
MaxN = 200;
BegChar = 'a';
FinChar = 'z';
type
PNode = ^TNode;
TNode = record
Num : Integer;
Fail, OutLink : PNode;
Edge : array[BegChar..FinChar] of PNode;
end;
TTranWord = record
S : string[MaxSize];
L : Byte;
P : PNode;
end;
var
TranWord : array[1..MaxN] of TTranWord;
InData : array[0..MaxN] of LongInt;
F,FOut : Text;
Root : PNode;
N : LongInt;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~}
procedure Init(var P : Pnode; Num : Integer; Fail : Pnode);
var
C : Char;
begin
New(P);
P^.Num := Num;
P^.Fail := Fail;
P^.OutLink := nil;
for C := BegChar to FinChar do P^.Edge[C] := nil;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~}
procedure InPut;
var
K, I : Integer;
Prev, CurFail : PNode;
C : Char;
begin
{reading}
Readln(F,N);
For i:=1 to N do
begin
ReadLn(F, TranWord[i].S);
TranWord[i].L := Length( TranWord[i].S );
end;
{init for the root of the tree}
Init(Root,0,nil);
{making the first level}
for I := 1 to N do with TranWord[I] do begin
C := S[1];
if Root^.Edge[C] = nil then Init(Root^.Edge[C],0,Root);
P := Root^.Edge[C];
if L = 1 then P^.Num := I;
end;
{making the other levels}
for K := 2 to MaxSize do
for I := 1 to N do with TranWord[I] do
if K <= L then begin
Prev := P;
C := S[K];
if Prev^.Edge[C] = nil then begin
Init(Prev^.Edge[C],0,nil);
P := Prev^.Edge[C];
if L = K then P^.Num := I;
CurFail := Prev^.Fail;
while (CurFail <> Root) and
(CurFail^.Edge[C] = nil) do CurFail := CurFail^.Fail;
if CurFail^.Edge[C] = nil then P^.Fail := Root
else P^.Fail := CurFail^.Edge[C];
if P^.Fail^.Num = 0 then P^.OutLink := P^.Fail^.OutLink
else P^.OutLink := P^.Fail;
end else begin
P := Prev^.Edge[C];
if L = K then P^.Num := I;
end;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~}
procedure OutPut;
var
I : Integer;
begin
for I := 1 to N do
WriteLn('The word ', TranWord[I].S, ' occurs ', InData[I], ' time(s).');
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~}
procedure ReadF(var C : Char);
begin
if Eoln(F) then ReadLn(F);
if (Eof(F)) then
begin
OutPut;
exit;
end else Read(F, C);
If C='$' then OutPut;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~}
procedure CheckOccurrence(W : PNode);
begin
while (W <> Root) and (W <> nil) do begin
Inc(InData[W^.Num]);
W := W^.OutLink;
end;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~}
procedure Go;
var
W : PNode;
C : Char;
begin
FillChar(InData, SizeOf(InData), 0);
ReadF(C);
W := Root;
repeat
while W^.Edge[C] <> nil do begin
W := W^.Edge[C];
CheckOccurrence(W);
ReadF(C);
if c='$' then exit;
end;
if W = Root then ReadF(C)
else W := W^.Fail;
if c='$' then exit;
until False;
end;
{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~}
var p : pointer;
NumOfTest,CurTest : integer;
begin
Mark(p);
Assign(F, InFile); ReSet(F);
Readln(F,NumOfTest);
For Curtest:=1 to NumOfTest do
begin
Writeln(FOut,'TEST ',CurTest);
InPut;
Go;
Release(P);
end;
Close(F);
end.
{
С уважением,
игорь Бобак
}
--- ifmail v.2.15dev5
* Origin: MTU-Intel ISP (2:5020/400)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
Re: Поиск набора слов в тексте с помощью конечных автоматов 