Cod sursa(job #385894)

Utilizator SzabiVajda Szabolcs Szabi Data 23 ianuarie 2010 18:37:25
Problema Trie Scor 5
Compilator fpc Status done
Runda Arhiva educationala Marime 2.01 kb
program meg_egy_proba;
type mut=^adat;
     adat=record
         betu:char;
         szam:integer;
         gyerek:0..30;
         a:array['a'..'z'] of mut;

     end;
var gy:mut;
f,g:text;
s:string;
temp:integer;
procedure nullaz(gy:mut);
var i:char;
begin
    for i:='a' to 'z' do
    gy^.a[i]:=nil;
    gy^.betu:=' ';
    gy^.szam:=0;
    gy^.gyerek:=0;

end;

procedure beszur(gy:mut;s:string);
var c:char;
begin
c:=' ';
c:=s[1];

if s='' then inc(gy^.szam) else

if gy^.a[c]=nil then begin
    new(gy^.a[c]);nullaz(gy^.a[c]);
    gy^.a[c]^.betu:=c;
    inc(gy^.gyerek);
    delete(s,1,1);
    beszur(gy^.a[c],s);
end else begin   delete(s,1,1);beszur(gy^.a[c],s); end;


end;

procedure torol(gy:mut;s:string);
var c:char;
begin
c:=' ';
c:=s[1];

if s='' then begin
    dec(gy^.szam);
end else begin
    delete(s,1,1);
    torol(gy^.a[c],s);

end;
if (gy^.a[c]<>nil) and (gy^.a[c]^.szam=0) and(gy^.a[c]^.gyerek=0) then begin
    dispose(gy^.a[c]);
    gy^.a[c]:=nil;
    dec(gy^.gyerek);
end;

end;

procedure szamol(gy:mut;s:string);
var c:char;
begin
    c:=' ';
    c:=s[1];
    if s='' then writeln(g,gy^.szam) else
    if (gy^.a[c]=nil) then writeln(g,'0') else
    begin
        delete(s,1,1);
        szamol(gy^.a[c],s);

    end;

end;

procedure kozos(gy:mut;s:string;x, max:integer);
var c:char;
begin
c:=' ';
c:=s[1];

  if (s='') or (gy^.a[c]=nil) then writeln(g,max) else begin
  if ((gy^.a[c]^.gyerek>=2)or(gy^.a[c]^.szam>=2)or(gy^.a[c]^.a[s[2]]=nil))and(x>max) then max:=x;
     delete(s,1,1);
     kozos(gy^.a[c],s,x+1,max);
  end;


end;

begin
assign(f,'trie.in');reset(f);
assign(g,'trie.out');rewrite(g);
new(gy);nullaz(gy);
gy^.betu:='x';
         while not(eof(f)) do begin
         readln(f,temp,s);
            delete(s,1,1);
         if temp=0 then beszur(gy,s) else
         if temp=1 then torol(gy,s) else
         if temp=2 then szamol(gy,s) else
         kozos(gy,s,1,0);
         end;

close(f);
close(g);

end.