Cod sursa(job #472022)

Utilizator zseeZabolai Zsolt zsee Data 22 iulie 2010 16:06:50
Problema Trie Scor 55
Compilator fpc Status done
Runda Arhiva educationala Marime 2.71 kb
program trie_pr;
const intervallumH = ord('z') - ord('0');

type
  intervallum = '0'..'z';
  Ptrie = ^Ttrie;
  Ttrie = record
           fiak : array[intervallum] of Ptrie;
           n,fn           : longint;
          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 ):longint;inline;
var index,l:integer;
    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: integer;
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 );
var cel:integer;
   function torol_r(var x:ptrie ; id : integer ):boolean;
   var b:boolean;
      i:byte;
   begin
    if x = nil then
       begin
        torol_r := false;
        exit;
       end;

    if id = cel+1 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);
 torol_r( fej, 1 );
end;


function prefcomun( s:string ):integer;
var index,l:integer;
    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.