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