Cod sursa(job #778735)
Program tri;
type trie=^celula;
celula=record
w,pr:longint;
sn:array ['a'..'z'] of trie;
end;
var root:trie;
op:byte;
i:longint;
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(ch:char; k:integer; aux:trie);
begin
dec(aux^.pr);
if k=length(s) then dec(aux^.w)
else sterge(s[k+1],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;
for i:=1 to 1 shl 18 do begin
readln(fi,op,ch,s); if s='' then break;
if op=0 then adauga(s)
else if op=1 then sterge(s[1],1,root^.sn[s[1]])
else if op=2 then printcuv(s)
else printpref(s);
end;
close(fo);
end.