Pagini recente » Cod sursa (job #3147911) | Cod sursa (job #512231) | Cod sursa (job #565183) | Cod sursa (job #2295180) | Cod sursa (job #472359)
Cod sursa(job #472359)
program trie_pr;
const intervallumH = ord('z') - ord('a');
type
intervallum = 'a'..'z';
Ptrie = ^Ttrie;
Ttrie = record
fiak : array[intervallum] of Ptrie;
n : longword;
fn : longword;
end;
var fej : Ptrie;
procedure uj( var x: Ptrie );inline;
begin
new(x);
x^.n := 0;
x^.fn := 0;
fillchar( x^.fiak , intervallumH*sizeof(Ptrie) , 0 );
end;
function bennevan( s:string ):longword;inline;
var index,l:byte;
p:Ptrie;
begin
index := 1;
p := fej;
l := length(s);
while index <= l do
begin
if p^.fiak[ s[index] ] = nil then
begin
bennevan := 0;
exit;
end;
p := p^.fiak[ s[index] ];
inc(index);
end;
bennevan := p^.n;
end;
procedure belerak( s:string );inline;
var p: Ptrie;
index,l: byte;
begin
p := fej;
index := 1;
l := length(s);
while index <= l do
begin
if p^.fiak[ s[index] ] = nil then
uj( p^.fiak[ s[index] ] );
inc( p^.fn );
p := p^.fiak[ s[index] ];
inc(index);
end;
inc( p^.n );
inc( p^.fn );
end;
procedure dispif(var x:Ptrie );inline;
begin
if (x^.n=0)and(x^.fn=0) then
begin
dispose( x );
x := nil;
end;
end;
procedure torol( s:string );inline;
var cel:byte;
function torol_r( var x:ptrie ; id : byte ):boolean;
var b:boolean;
begin
if x = nil then
begin
torol_r := false;
exit;
end;
if id = cel then // megerkeztunk
begin
dec( x^.n );
dec( x^.fn );
dispif( x );
b := true;
exit;
end;
b := torol_r( x^.fiak[ s[id] ] , id + 1 );
if b then
begin
dec( x^.fn );
dispif( x );
end;
torol_r := b;
end;
begin
cel := length(s) +1;
torol_r( fej, 1 );
end;
function prefcomun( s:string ):byte;inline;
var index,l:byte;
p:ptrie;
begin
index := 1;
l := length(s);
p := fej;
while index <= l do
begin
if p^.fiak[ s[index] ] = nil then
begin
prefcomun := index-1;
exit;
end;
p := p^.fiak[ s[index] ];
inc(index);
end;
prefcomun:= index - 1;
end;
var be,ki:text;
rbuf,wbuf:array[1..32000] of byte;
act:byte;
s :string;
c :char;
begin
assign(be,'trie.in');
assign(ki,'trie.out');
settextbuf( be, rbuf );
settextbuf( ki, wbuf );
reset(be);
rewrite(ki);
uj(fej);
while not eof(be) do
begin
read(be, act, c);
readln(be, s);
//writeln(act,c,s);
case act of
0: belerak(s);
1: torol(s);
2: writeln(ki, bennevan(s) );
3: writeln(ki, prefcomun(s) );
end;
end;
close(ki);
close(be);
end.