Cod sursa(job #1179542)

Utilizator wollyFusy Wool wolly Data 28 aprilie 2014 20:34:38
Problema Heapuri Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.66 kb
type poz1=array[1..200100] of longint;
	 poz2=array[1..200100] of longint;
	 heap=array[1..200100] of longint;
var a,b:text;
	num,op,n,i,j,k:longint;
	h:heap;
	t:poz1;
	u:poz2;
	
procedure up(p:longint);
var r1,r2,r3:longint;
begin
	while (h[p]<h[p div 2]) and (p>1) do
		begin
		r1:=h[p div 2];
		h[p div 2]:=h[p];
		h[p]:=r1;
		r2:=t[u[p]]; 
		t[u[p]]:=t[u[p div 2]];
		t[u[p div 2]]:=r2;
		r3:=u[p];
		u[p]:=u[p div 2];
		u[p div 2]:=r3;
		p:=p div 2;
		end;
end;
	
procedure down(p:longint);
var r1,r2,r3,ex:longint;
begin
	ex:=1;
	while (p<=(j div 2)) and (p>0) and (ex=1) do
	begin
		ex:=0;
		if (h[2*p+1]<h[p]) and (h[2*p+1]<h[2*p]) then
			begin
			r1:=h[p];
			h[p]:=h[2*p+1];
			h[p*2+1]:=r1;
			r2:=t[u[p]]; 
			t[u[p]]:=t[u[2*p+1]];
			t[u[2*p+1]]:=r2;
			r3:=u[p];
			u[p]:=u[2*p+1];
			u[2*p+1]:=r3;
			p:=2*p+1;
			ex:=1;
		end else
		if (h[2*p]<h[p]) then
			begin
			r1:=h[p];
			h[p]:=h[p*2];
			h[p*2]:=r1;
			r2:=t[u[p]]; 
			t[u[p]]:=t[u[2*p]];
			t[u[p*2]]:=r2;
			r3:=u[p];
			u[p]:=u[p*2];
			u[p*2]:=r3;
			p:=p*2;
			ex:=1;
			end;
	end;
end;
	
procedure add(num:longint);
begin
	j:=j+1;
	h[j]:=num;
	t[k]:=j;
	u[j]:=k;
	up(j);
end;	
	
procedure del(p:longint);
begin
	p:=t[p];
	h[p]:=h[j];
	t[u[j]]:=t[u[p]];
	u[p]:=u[j];
	j:=j-1;
	if p>1 then up(p);
	if p<=(j div 2) then down(p);
end;	
	
begin
assign(a,'heapuri.in'); reset(a);
assign(b,'heapuri.out'); rewrite(b);
readln(a,n);
for i:=1 to n do
	begin
	read(a,op);
	case op of
		1:begin read(a,num); k:=k+1; add(num); end;
		2:begin read(a,num); del(num); end;
		3:writeln(b,h[1]);
	end;
	end;
close(a);
close(b);
end.