Cod sursa(job #539150)

Utilizator andreirulzzzUPB-Hulea-Ionescu-Roman andreirulzzz Data 22 februarie 2011 15:50:33
Problema Trie Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 3.6 kb
Type pnod=^nod;
        nod=record
            st,dr:pnod;
            ap:longint;
            cuv:string[21];
            end;

Var x,lmax:integer;
    s:string[21];
    f,g:text;
    prim,p:pnod;

procedure pr0;
        var p,q,aux:pnod;

        begin
        p:=prim;
        While p<>nil do
           Begin
           if s=p^.cuv then begin
                            p^.ap:=p^.ap+1;
                            break;
                            end
           else if s>p^.cuv then begin
                                 aux:=p;
                                 p:=p^.dr;
                                 end
           else begin
                aux:=p;
                p:=p^.st;
                end;
           End;
        If p=nil then begin
                      p:=aux;
                      new(q);
                      q^.cuv:=s;
                      q^.ap:=1;
                      q^.st:=nil;
                      q^.dr:=nil;
                      if q^.cuv>p^.cuv then
                                            p^.dr:=q
                      else p^.st:=q;
                      end;
        End;


procedure pr1;
       var p:pnod;

        begin
        p:=prim;
        While p<>nil do
           Begin
           if s=p^.cuv then begin
                            p^.ap:=p^.ap-1;
                            break;
                            end
           else if s>p^.cuv then p:=p^.dr

           else p:=p^.st;

           End;

        End;

procedure pr2;
        var p:pnod;
            ok:boolean;

        begin
        p:=prim;   ok:=false;
        While p<>nil do
           Begin
           if s=p^.cuv then begin
                            writeln(g,p^.ap);
                            ok:=true;
                            break;
                            end
           else if s>p^.cuv then p:=p^.dr

           else p:=p^.st;

           End;

        If not ok then writeln(g,0);
        End;

Procedure SVD(p:pnod);
        var l:integer;

        begin
        if p<>nil then
            begin
            SVD(p^.dr);
            l:=1;
            If p^.ap>0 then
             while(s[l+1]=p^.cuv[l+1])and(l<length(s))and(l<length(p^.cuv)) do
             inc(l);

            If l>lmax then lmax:=l;
            SVD(p^.st);
            end;
        end;

procedure pr3;
        var p:pnod;
            ok:integer;
        begin
        lmax:=0;ok:=0;
        p:=prim;
        While p<>nil do
            Begin
            If (p^.cuv[1]=s[1]) then begin
                                     ok:=1;
                                     break;
                                     end
            else if p^.cuv[1]<s[1] then p:=p^.dr
            else p:=p^.st;
            end;
        If ok=0 then begin
                       writeln(g,0);
                       exit;
                       end;
        svd(p);
        writeln(g,lmax);
        end;


Begin
assign(f,'trie.in');
reset(f);
read(f,x);
assign(g,'trie.out');
rewrite(g);
readln(f,s);delete(s,1,1);
while (x<>0) do begin
        read(f,x);
        readln(f,s);
        delete(s,1,1);
        writeln(g,'0');
        end;
if x=0 then begin
            new(p);
            p^.st:=nil;
            p^.dr:=nil;
            p^.cuv:=s;
            p^.ap:=1;
            prim:=p;
            end;
While not eof(f) do
    Begin
    read(f,x);
    readln(f,s);
    delete(s,1,1);
    If x=0 then pr0
    else if x=1 then pr1
    else if x=2 then pr2
    else if x=3 then pr3;
    end;
close(f);
writeln;
close(g);
end.