Cod sursa(job #778726)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 15 august 2012 18:05:23
Problema Trie Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.78 kb
Program tri;
type trie=^celula;
  celula=record
        w,pr:longint;
         sn:array ['a'..'z'] of trie;
       end;
var root:trie;
    op:byte;
    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(s:string; k:longint; aux:trie);
begin
  dec(aux^.pr);
   if k=length(s) then dec(aux^.w)
    else sterge(s,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;
 while not seekeof(fi) do begin
  readln(fi,op,ch,s);
   if op=0 then adauga(s)
   else if op=1 then sterge(s,1,root^.sn[s[1]])
   else if op=2 then printcuv(s)
   else printpref(s);
  end;
 close(fo);
end.