Cod sursa(job #1217651)

Utilizator RusuAlexeiRusu Alexei RusuAlexei Data 7 august 2014 21:09:03
Problema Trie Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.9 kb
program trie1;
  type trie=^nod;
       alfabet=array['a'..'z']of trie;
       nod=record
             info,pas:longint;
             alf:alfabet;
           end;
  var bufin,bufout:array[1..100000]of byte;
      op:byte;
      s:ansistring;
      t:trie;
      c:char;

procedure add(s:ansistring);
  var q,r:trie;
      i,l:longint;
  begin
    q:=t;
    i:=1; l:=length(s);
    while (i<=l)and(q^.alf[s[i]]<>nil)do
      begin
        q:=q^.alf[s[i]];
        inc(q^.pas);
        inc(i);
      end;
    for i:=i to l do
      begin
        new(r);
        r^.info:=0;
        r^.pas:=1;
        q^.alf[s[i]]:=r;
        q:=r;
      end;
    inc(q^.info);
  end;

procedure delete(s:ansistring);
  var q,r:trie;
      i,l:longint;
  begin
    q:=t;l:=length(s);
    for i:=1 to l do
      begin
        q:=q^.alf[s[i]];
        dec(q^.pas);
      end;
    dec(q^.info);
  end;

function count(s:ansistring):longint;
  var q,r:trie;
      i,l:longint;
  begin
    q:=t;
    l:=length(s);
    i:=1;
    while (i<=l)and(q^.alf[s[i]]<>nil)do
      begin
        q:=q^.alf[s[i]];
        inc(i);
      end;
    if i=l+1 then count:=q^.info else count:=0;
  end;

function prefix(s:ansistring):longint;
  var q,r:trie;
      i,l,ans:longint;
  begin
    q:=t;
    l:=length(s);
    i:=1;
    ans:=0;
    while (i<=l)and(q^.alf[s[i]]<>nil)do
      begin
        q:=q^.alf[s[i]];
        if q^.pas>0 then ans:=i;
        inc(i);
      end;
    exit(ans);
  end;


begin
  assign(input,'trie.in');
  reset(input);
  settextbuf(input,bufin);
  assign(output,'trie.out');
  rewrite(output);
  settextbuf(output,bufout);

  new(t);

  while not eof do
    begin
      readln(op,c,s);
      if op=0 then add(s) else
      if op=1 then delete(s) else
      if op=2 then writeln(count(s)) else
         writeln(prefix(s));
    end;
  close(output);
end.