Cod sursa(job #760687)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 22 iunie 2012 17:11:12
Problema Heapuri Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.55 kb
Program heapuri;
const inf=2000000000;
 var h,a,ord:array [0..1 shl 19] of longint;
     b1,b2:array [1..1 shl 17] of char;
     n,lev,nr,op,x,i,nod:longint;
     fi,fo:text;
procedure swap(p1,p2:longint);
 var aux:longint;
begin
 aux:=h[p1]; h[p1]:=h[p2]; h[p2]:=aux;
  ord[nr]:=ord[p2]; ord[p2]:=p1;
end;
procedure urca(nod:longint);
begin
 while (nod>=1) and (h[nod div 2]>h[nod]) do begin
                                             swap(nod,nod div 2);
                                                  nod:=nod div 2;
                                                  end;
 end;
procedure coboara(nod:longint);
 var aux:longint;
begin
 if (h[nod]>h[2*nod]) and (2*nod<=nr) then begin swap(nod,2*nod); coboara(2*nod); end
  else if (h[nod]>h[2*nod+1]) and (2*nod+1<=nr) then begin swap(nod,2*nod+1); coboara(2*nod+1); end;
end;
procedure insert(x:longint);
 begin
  inc(nr); h[nr]:=x; inc(lev); a[lev]:=x;
    ord[lev]:=nr;
     urca(nr);
 end;
procedure erase(x:longint);
begin
 nod:=ord[x];
    h[nod]:=10000000; dec(nr);
  if h[nod]<h[nod div 2] then urca(nod)
   else if (h[nod]>h[2*nod]) or (h[nod]>h[2*nod+1]) then coboara(nod);
end;
begin
 assign(fi,'heapuri.in');
  assign(fo,'heapuri.out');
 settextbuf(fi,b1); settextbuf(fo,b2);
 reset(fi); rewrite(fo); readln(fi,n);
  for i:=1 to n do begin
    read(fi,op);
     if op=1 then begin readln(fi,x); insert(x); end
      else if op=2 then begin readln(fi,x); erase(x); end
       else begin readln(fi); writeln(fo,h[1]); end;
                     end;
  close(fo);
end.