подсчет слов в Trie дереве Опции

[redeezko]

Добрый день. Помогите пожалуйста с задачей: в Trie дереве подсчитать количество слов, в которых имеется буква "а" (все буквы маленькие, латинские).

Собственно, проблема в написании одной процедуры - поиска слова с заданной буквой. Описание, создание, печать и другие нужные мне процедуры написал. Прилагаю код:

unit Unit1;
interface
 type
 TIndex='a'..'z';
 TrieTree=^TNode;
 TNode=record
        Ptrs:array [TIndex] of TrieTree;
        eow:boolean;
       end;
 TTrieTree=object
           private
            TTree:TrieTree;
           public
            constructor Init;
            function Empty:boolean;
            procedure Push(s:string);
            function find(s:string):boolean;
            procedure pop(s:string);
            procedure print;
            procedure clear;
            destructor done; virtual;
end;

implementation
Constructor TTrieTree.Init;
begin
 TTree:=nil;
end;

function TTrieTree.Empty;
begin
 Empty:=TTree=nil
end;

Procedure TTrieTree.Push(s:string);
 Procedure PushString(var T:TrieTree; i:byte);
 var ch:TIndex;
 begin
  if t=nil then
   begin
    new(t);
    T^.eow:=false;
    for ch:=low(Tindex) to High(Tindex) do
     T^.Ptrs[ch]:=nil;
   end;
  if length(s)<i then
   t^.eow:=true
  else
   PushString(T^.Ptrs[s[i]],i+1)
 end;
begin
 if Length(s)>0 then pushstring(TTree,1)
end;

function TTrieTree.find(s:string):boolean;
 function FindString(T:TrieTree; i:byte):boolean;
 var ch:TIndex;
 begin
  if T=nil then
   FindString:=false
  else
   if Length(s)<i then
    FindString:=T^.eow
   else
    FindString:=FindString(T^.Ptrs[s[i]],i+1)
 end;
begin
 if Length(s)=0 then
  Find:=false
 else
  Find:=FindString(TTree,1)
end;

Procedure TTrieTree.pop(s:string);
function AllEmpty(T:TrieTree):boolean;
var ch:TIndex; fl:boolean;
begin
 fl:=not T^.eow;
 ch:=Low(TIndex);
 while (ch<=High(TIndex)) and fl do
  if T^.Ptrs[ch]=nil then
   ch:=succ(ch)
  else
   fl:=false;
  AllEmpty:=fl;
end;

Procedure PopString(var T:TrieTree; i:byte);
var ch:TIndex;
begin
 if (t<>nil) then
  if i<=length(s) then
   PopString(t^.Ptrs[s[i]],i+1)
  else
   begin
    T^.eow:=false;
    if allempty(t) then
     begin
      dispose(t);
      T:=nil;
     end;
   end;
end;

begin
 if length(s)>0 then
  PopString(TTree,1);
end;

Procedure TTrieTree.print;
procedure PrintString(T:TrieTree; s:string);
var ch:TIndex;
begin
 if t^.eow then
  writeln(s);
 for ch:=Low(Tindex) to High (TIndex) do
  if t^.Ptrs[ch]<>nil then
   begin
    if ch='a' then writeln('!!!');
    PrintString(T^.Ptrs[ch],s+ch);
   end;
end;
begin
 if not Empty then
  PrintString(TTree,'')
 else
  writeln('Tree is empty');
end;

procedure TTrieTree.clear;
procedure delNodes(var T:TrieTree);
var ch:TIndex;
begin
 for ch:=Low(Tindex) to High(Tindex) do
  if T^.Ptrs[ch] <> nil then
   DelNodes(T^.Ptrs[ch]);
  dispose(t);
  t:=nil;
end;
begin
 if not Empty then DelNodes(TTree);
end;

destructor TTrieTree.done;
begin
 if TTree<>nil then Clear;
end;

end.

Сообщение отредактировано: redeezko - 8.05.2011 10:50

[Гость]

Примерно так:

procedure Find(LastLetter: char; T: PNode; C: char);
var
  i: char;
begin
  if (T <> nil) and (T^.eow) then begin 
    if LastLetter = C then 
      WriteAllChilds(T)
    else
      for i := Low(T^.Ptrs) to High(T^.Ptrs) do Find(i, T^.Ptrs[i], C);
  end;
end;

Только названия типам и полям дай нормальные, например, такие:

TIndex='a'..'z';
 PNode=^TNode; // стандартно для указателя просто заменяют в начале T на P
 TNode=record
        Ptrs:array [TIndex] of PNode;
        eow:boolean;
       end;
 TTrieTree=object
           private
            Node:PNode;
   ...

[redeezko]

Спасибо большое за ответ =). Но непонятно LastLetter - это что за параметр? Что им будет в программе, при вызове
данной процедуры?

[-TarasBer-]

LastLetter - это как бы индекс данного узла по отношению к родителькому массиву. При первом вызове надо в качестве него написать что-то, не являющееся C. Да, фигня какая-то.

Лучше сделать его boolean.
То есть лучше так:

procedure Find(LastLetter_is_C: boolean; T: PNode; C: TIndex);
var
  i: TIndex;
begin
  if (T <> nil) and (T^.eow) then begin 
    if LastLetter_is_C then 
      WriteAllChilds(T)
    else
      for i := Low(T^.Ptrs) to High(T^.Ptrs) do Find(i=C, T^.Ptrs[i], C);
  end;
end;

А при первом вызове делать его False.

[redeezko]

Что то не получается...
Вставил в свой код данную процедуру вот таким образом:

procedure TTrieTree.sum;
procedure findletter(f:boolean; T:TrieTree; c:TIndex);
var i:TIndex;
begin
 if (t<>nil) and (t^.eow) then
  begin
   if f then
    writeln('!!!') //здесь должно быть увеличение счетчика, но пока поставил это для тестирования
   else
    for i:=Low(T^.Ptrs) to High(T^.Ptrs) do
      findletter(i=c,t^.ptrs[i],c);
  end;
end;
var flag:boolean; c:char;
begin
 flag:=false;
 c:='a';
 findletter(flag,TTree,c);
end;

При пошаговом выполнении данной процедуры в программе, компилятор доходит до строки

f (t<>nil) and (t^.eow) then

и завершает работу данной процедуры. Если заменить and на or, то она выполняется один раз (находится только первая буква "а"), но затем сразу следует крах всей программы..

Сообщение отредактировано: redeezko - 8.05.2011 12:42

[IUnknown]

в Trie дереве подсчитать количество слов, в которых имеется буква "а"

По аналогии с методом Print:

function TTrieTree.CountAWords : Integer;

var
   Count : Integer;

   procedure ComposeString(T : TrieTree; s : string);
   var Ch : Tindex;
   begin
      if T^.Eow then if Pos('a', s) > 0 then Inc(Count);

      for Ch := Low (Tindex) to High (TIndex) do
         if T^.Ptrs[Ch] <> nil then
         begin
            ComposeString(T^.Ptrs[ch], s + ch);
         end;
   end;

begin
   Count := 0;
   if not Empty then
      ComposeString(TTree, '')
   else
      writeln('Tree is empty');
   CountAWords := Count;
end;

Можн, конечно, еще пошаманить, чтоб всю строку не собирать...

[redeezko]

Большое спасибо! Так все получилось, хотя способ и правда не самый лучший.

[IUnknown]

Вот чуть лучше:

function TTrieTree.CountAWords : Integer;

var
   Count : Integer;

   procedure ComposeString(APresent: boolean; T : TrieTree);
   var Ch : Tindex;
   begin
      if T^.Eow then if APresent then Inc(Count);

      for Ch := Low (Tindex) to High (TIndex) do
         if T^.Ptrs[Ch] <> nil then
         begin
            ComposeString(APresent or (Ch = 'a'), T^.Ptrs[ch]);
         end;
   end;

begin
   Count := 0;
   if not Empty then
      ComposeString(false, TTree)
   else
      writeln('Tree is empty');
   CountAWords := Count;
end;

, от явного собирания строк избавились, от проверок Pos-ом тоже.

[-Михаил-]

Выложите архив самой программки пожалуйста.