I use a variation of segment tree--square tree, dividing each node into 4 instead of 2. Complexity O(n*(logn)^2). I got AC on USACO at 1.45s, but it's MLE. And I suspect I shall get TLE if I use O(n^2*logn). (+)
program ural1147;
const
maxn=1000;
maxc=2500;
type
pointer=^node;
node=record
l,r,b,t,c:word;
lb,rb,lt,rt:pointer;
end;
var
x1,y1,x2,y2,color:array[0..maxn]of word;
lx,ly:array[0..maxn*2+2]of word;
area:array[1..maxc]of longint;
n,i,t:word;
root:pointer;
procedure qsort(var a:array of word;s,t:word);
var
p,i,j,tmp:word;
begin
if s>=t then exit;
p:=s+random(t-s+1);
tmp:=a[p];a[p]:=a[s];
i:=s;j:=t;
repeat
while (i<j) and (a[j]>=tmp) do dec(j);
if i=j then break;a[i]:=a[j];inc(i);
while (i<j) and (a[i]<=tmp) do inc(i);
if i=j then break;a[j]:=a[i];dec(j);
until i=j;
a[i]:=tmp;
qsort(a,s,i-1);
qsort(a,i+1,t);
end;
procedure makelines(var a,b,l:array of word);
var
i:word;
begin
for i:=0 to n do begin
l[i*2+1]:=a[i];l[i*2+2]:=b[i];
end;
qsort(l,1,n*2+2);
l[0]:=1;
for i:=2 to n*2+2 do
if l[i]>l[i-1] then begin
inc(l[0]);
l[l[0]]:=l[i];
end;
end;
function search(l:array of word;x:word):word;
var
s,t,m:word;
begin
s:=1;t:=l[0];
repeat
m:=(s+t) shr 1;
if l[m]=x then break;
if l[m]<x then s:=m+1 else t:=m-1;
until false;
search:=m;
end;
function min(a,b:word):word;
begin
if a<b then min:=a else min:=b;
end;
function max(a,b:word):word;
begin
if a>b then max:=a else max:=b;
end;
procedure recycle(p:pointer);
begin
if p=nil then exit;
recycle(p^.lb);recycle(p^.rb);recycle(p^.lt);recycle(p^.rt);
dispose(p);
end;
procedure cover(p:pointer;sx,tx,sy,ty,clr:word);
var
mx,my:word;
begin
if (sx>=tx) or (sy>=ty) then exit;
if p^.c=clr then exit;
if (sx=p^.l) and (tx=p^.r) and (sy=p^.b) and (ty=p^.t) then begin
p^.c:=clr;
recycle(p^.lb);recycle(p^.rb);recycle(p^.lt);recycle(p^.rt);
with p^ do begin lb:=nil;rb:=nil;lt:=nil;rt:=nil;end;
exit;
end;
mx:=(p^.l+p^.r) shr 1;my:=(p^.b+p^.t) shr 1;
if p^.c>0 then begin
new(p^.lb);with p^.lb^ do begin l:=p^.l;r:=mx;b:=p^.b;t:=my;c:=p^.c;lb:=nil;rb:=nil;lt:=nil;rt:=nil;end;
new(p^.rb);with p^.rb^ do begin l:=mx;r:=p^.r;b:=p^.b;t:=my;c:=p^.c;lb:=nil;rb:=nil;lt:=nil;rt:=nil;end;
new(p^.lt);with p^.lt^ do begin l:=p^.l;r:=mx;b:=my;t:=p^.t;c:=p^.c;lb:=nil;rb:=nil;lt:=nil;rt:=nil;end;
new(p^.rt);with p^.rt^ do begin l:=mx;r:=p^.r;b:=my;t:=p^.t;c:=p^.c;lb:=nil;rb:=nil;lt:=nil;rt:=nil;end;
p^.c:=0;
end;
cover(p^.lb,sx,min(mx,tx),sy,min(my,ty),clr);
cover(p^.rb,max(mx,sx),tx,sy,min(my,ty),clr);
cover(p^.lt,sx,min(mx,tx),max(my,sy),ty,clr);
cover(p^.rt,max(mx,sx),tx,max(my,sy),ty,clr);
end;
procedure stat(p:pointer);
begin
if p^.c>0 then
inc(area[p^.c],(lx[p^.r]-lx[p^.l])*(ly[p^.t]-ly[p^.b]))
else begin
stat(p^.lb);stat(p^.rb);stat(p^.lt);stat(p^.rt);
end;
end;
begin
x1[0]:=0;y1[0]:=0;read(x2[0],y2[0],n);
for i:=1 to n do
read(x1[i],y1[i],x2[i],y2[i],color[i]);
makelines(x1,x2,lx);
makelines(y1,y2,ly);
new(root);
with root^ do begin
l:=1;r:=lx[0];b:=1;t:=ly[0];c:=1;
lb:=nil;rb:=nil;lt:=nil;rt:=nil;
end;
for i:=1 to n do
cover(root,search(lx,x1[i]),search(lx,x2[i]),search(ly,y1[i]),search(ly,y2[i]),color[i]);
fillchar(area,sizeof(area),0);
stat(root);
for i:=1 to maxc do
if area[i]>0 then
writeln(i,' ',area[i]);
end.