Cod sursa(job #338558)

Utilizator sapiensCernov Vladimir sapiens Data 6 august 2009 00:18:42
Problema Heapuri Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.85 kb
Program heapuri;
 var f,g:text; heap:array[1..200000]of longint;
     b:array[1..200000]of longint;
     k,n,num:longint;
 procedure swap (x,y:longint);
  var z:longint;
  begin
   z:=heap[x];
   heap[x]:=heap[y];
   heap[y]:=z;
  end;
 procedure cerne (x:longint);
  var y:integer;
  begin
   if 2*x<=num then begin
     y:=x;
     if heap[2*x]<heap[y] then y:=2*x;
     if (2*x+1)<=num then if heap[2*x+1]<heap[y] then y:=2*x+1;
     swap (x,y);
     if (x<>y) then cerne (y);
   end;
  end;
 procedure ridica (x:longint);
  begin
   if x>1 then
     if heap[x div 2]>heap[x] then begin
       swap (x div 2,x);
       ridica (x div 2);
     end;
  end;
 procedure adauga (x:longint);
  begin
   num:=num+1;
   heap[num]:=x;
   ridica (num);
  end;
 function get (x,y:longint):longint;
  begin
   if heap[y]=x then get:=y else begin
     if ((2*y)<=num) and (heap[y]<x) then get:=get (x,2*y);
     if ((2*y+1)<=num) and (heap[y]<x) then get:=get (x,2*y+1);
   end;
  end;
 procedure sterge (x:longint);
  var y:longint;
  begin
   y:=get (x,1);
   swap (y,num);
   num:=num-1;
   cerne (y);
   ridica (y);
  end;
 procedure calcul;
  var x,z,w:longint; y:1..3;
  begin
   for x:=1 to n do begin
     read (f,y);
     case y of
       1: begin
            readln (f,z);
            k:=k+1;
            b[k]:=z;
            adauga (z);
          end;
       2: begin
            readln (f,z);
            sterge (b[z]);
          end;
       3: begin
           writeln (g,heap[1]);
           readln (f);
          end;
     end;
   end;
  end;
 procedure scrie;
  var x:longint;
  begin
   for x:=1 to num do write (heap[x],' '); writeln;
  end;
 begin
  assign (f,'heapuri.in'); reset (f);
  assign (g,'heapuri.out'); rewrite (g);
  readln (f,n);
  k:=0;
  num:=0;
  calcul;
  close (f); close (g);
 end.