Cod sursa(job #778726)
Program tri;
type trie=^celula;
celula=record
w,pr:longint;
sn:array ['a'..'z'] of trie;
end;
var root:trie;
op:byte;
s:string;
b1,b2:array [1..1 shl 17] of char;
ch:char;
fi,fo:text;
procedure adauga(s:string);
var k:longint;
aux:trie;
begin
aux:=root;
for k:=1 to length(s) do
if aux^.sn[s[k]]=nil then begin
new(aux^.sn[s[k]]);
aux:=aux^.sn[s[k]];
for ch:='a' to 'z' do aux^.sn[ch]:=nil;
aux^.pr:=1; aux^.w:=0;
end
else begin
aux:=aux^.sn[s[k]];
aux^.pr:=aux^.pr+1;
end;
aux^.w:=aux^.w+1;
end;
procedure sterge(s:string; k:longint; aux:trie);
begin
dec(aux^.pr);
if k=length(s) then dec(aux^.w)
else sterge(s,k+1,aux^.sn[s[k+1]]);
{if aux^.pr=0 then dispose(aux);}
end;
procedure printcuv(s:string);
var k:longint;
aux:trie;
begin
aux:=root;
for k:=1 to length(s) do if aux<>nil then aux:=aux^.sn[s[k]] else break;
if aux<>nil then writeln(fo,aux^.w) else writeln(fo,'0');
end;
procedure printpref(s:string);
var k,sol:longint;
aux:trie;
begin
aux:=root; k:=1; sol:=1;
while (aux^.sn[s[k]]<>nil) and (k<=length(s)) do begin
aux:=aux^.sn[s[k]];
inc(k);
end;
writeln(fo,k-1);
end;
begin
assign(fi,'trie.in');
assign(fo,'trie.out');
settextbuf(fi,b1); settextbuf(fo,b2);
reset(fi); rewrite(fo);
new(root); root^.w:=0; root^.pr:=0;
for ch:='a' to 'z' do root^.sn[ch]:=nil;
while not seekeof(fi) do begin
readln(fi,op,ch,s);
if op=0 then adauga(s)
else if op=1 then sterge(s,1,root^.sn[s[1]])
else if op=2 then printcuv(s)
else printpref(s);
end;
close(fo);
end.