Pagini recente » Cod sursa (job #2845415) | Cod sursa (job #1173621)
type adresa=^trie;
trie=record
c:char;
x,nr:longint;
f,fr:adresa;
end;
var a,x,p:adresa;
n,i,j:longint;s:string;b:boolean;c,cc:char;
procedure add;
var n:byte;
begin
x:=a;n:=length(s);
for j:=1 to n do
begin
if x^.f=nil then
begin
new(p);
p^.f:=nil;
p^.fr:=nil;
p^.c:=s[j];
p^.x:=1;
if j=n then p^.nr:=1 else p^.nr:=0;
x^.f:=p;x:=p;
end else
begin
x:=x^.f;
while(x^.fr<>nil)and(x^.c<>s[j]) do x:=x^.fr;
if x^.c=s[j] then begin inc(x^.x);if j=n then inc(x^.nr);end else
begin
new(p);
p^.f:=nil;
p^.fr:=nil;
p^.c:=s[j];
p^.x:=1;
if j=n then p^.nr:=1 else p^.nr:=0;
x^.fr:=p;x:=p;
end;
end;
end;
end;
procedure delete;
var n:byte;
begin
x:=a^.f;
n:=length(s);b:=false;
for j:=1 to n do
if not b then
begin
while (x^.fr<>nil)and(x^.c<>s[j]) do x:=x^.fr;
if x^.c=s[j] then
begin
if x^.x=1 then begin b:=true; dec(x^.x);if j=n then dec(x^.nr);end else
begin
dec(x^.x);
if j=n then dec(x^.nr);
x:=x^.f;
end;
end else b:=true;
end;
end;
function aparitii:longint;
var n:byte;k:longint;
begin
x:=a^.f; k:=0;
if x=nil then aparitii:=0 else
begin
n:=length(s);b:=false;
for j:=1 to n do
if not b then
begin
if x=nil then b:=true else
begin
while (x^.fr<>nil)and(x^.c<>s[j]) do x:=x^.fr;
if x^.c=s[j] then
begin
if j=n then k:=x^.nr else x:=x^.f;
end else begin b:=true; k:=0; end;
end;
end;
aparitii:=k;
end;
end;
function prefix:integer;
var n,k:byte;
begin
n:=length(s);x:=a^.f;k:=0;
if x=nil then prefix:=0 else
begin
b:=false;
for j:=1 to n do
if not b then
begin
while (x^.fr<>nil)and(x^.c<>s[j]) do x:=x^.fr;
if (x^.c=s[j])and(x^.x>0) then begin k:=k+1;x:=x^.f;if x=nil then b:=true;
end else b:=true;
end;
prefix:=k;
end;
end;
begin
assign(input,'trie.in');reset(input);
assign(output,'trie.out');rewrite(output);
new(a);a^.f:=nil;a^.fr:=nil;
while not eof(input) do
begin
readln(c,cc,s);
case c of
'0': add;
'1': delete;
'2': writeln(aparitii);
'3': writeln(prefix);
end;
end;
close(input);
close(output);
end.