Cod sursa(job #472017)

Utilizator zseeZabolai Zsolt zsee Data 22 iulie 2010 15:38:24
Problema Trie Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.59 kb
program trie_pr;
const intervallumH = ord('z') - ord('a') + ord('9') - ord('0');

type
  intervallum = 'a'..'z'+'0'..'9';
  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 );
end;

procedure dispif( x:Ptrie );inline;
begin
 if (x^.n=0)and(x^.fn=0) then
    dispose( x );
end;

procedure torol( s:string );
var cel:integer;
   function torol_r( x:ptrie ; id : integer ):boolean;
   var b:boolean;
   begin
    if x = nil then
       begin
        torol_r := false;
        exit;
       end;
    if id = cel then // megerkeztunk
       begin
        dec( x^.n );
        b := true;
       end
          else
        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:array[1..32000] of byte;
    act:byte;
    s :string;
    c :char;
begin
 assign(be,'trie.in');
 assign(ki,'trie.out');
 settextbuf( be, rbuf );
 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.