Cod sursa(job #562430)

Utilizator andrei31Andrei Datcu andrei31 Data 23 martie 2011 00:29:09
Problema Arbori de intervale Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.47 kb
const mmax=100000;
type punct=record
           x,y:longword;
           end;
     ev=record
        p,t:longword;
        sgn:byte;
        end;
var n,m,nrh:longword;
    t:array[1..1 shl 18] of longword;
    ind:array[1..mmax] of longword;
    strazi:array[0..5*mmax] of punct;
    h:array[1..2*mmax] of ev;


procedure citeste;
var i:longword;
begin
assign(input,'8-minuni.in');reset(input);
readln(n,m);
for i:=1 to m do
 begin
 readln(strazi[i].x,strazi[i].y);
 h[2*i-1].p:=strazi[i].x;h[2*i-1].sgn:=1;h[2*i-1].t:=i;
 h[2*i].p:=strazi[i].y;h[2*i].sgn:=0;h[2*i].t:=i;
 end;
nrh:=2*m;
close(input);
end;

procedure swap(i,j:longword);
var aux:ev;
begin
aux:=h[i];
h[i]:=h[j];
h[j]:=aux;
end;

procedure heapdw(i,n:longword);
var go:longword;
begin
go:=i;
if (2*i<=n) and (h[i].p<h[2*i].p) then go:=2*i;
if (2*i+1<=n) and (h[go].p<h[2*i+1].p) then go:=2*i+1;
if go<>i then
  begin
  swap(go,i);
  heapdw(go,n);
  end;
end;

procedure heapsort;
var i:longword;

begin
for i:=nrh div 2 downto 1 do heapdw(i,nrh);
for i:=nrh downto 2 do
 begin
 swap(1,i);
 heapdw(1,i-1);
 end;
end;

procedure update(nod,l,r,p,v:longword);
var m:longword;
begin
m:=(l+r) div 2;
if l<r then
 if p<=m then update(2*nod,l,m,p,v)
  else update(2*nod+1,m+1,r,p,v);
if l=r then t[nod]:=v else
   if strazi[t[2*nod]].x>strazi[t[2*nod+1]].x then t[nod]:=t[2*nod] else t[nod]:=t[2*nod+1];
end;

function max(a,b:longword):longword;
begin
if strazi[a].x>strazi[b].x then max:=a else max:=b;
end;

function query(nod,l,r,a,b:longword):longword;
var m,tt:longword;
begin
if a>b then
 begin
 query:=0;
 exit;
 end;
tt:=0;
if (a<=l) and (r<=b) then tt:=t[nod]
 else
  begin
  m:=(l+r) div 2;
  if a<=m then tt:=max(tt,query(2*nod,l,m,a,b));
  if m<b then tt:=max(tt,query(2*nod+1,m+1,r,a,b));
  end;
query:=tt;
end;

procedure prepare;
var i:longword;
begin
for i:=1 to nrh do
 begin
 if h[i].sgn=1 then
  ind[h[i].t]:=query(1,1,m,1,h[i].t-1);
 update(1,1,m,h[i].t,h[i].t*h[i].sgn);
 end;
end;

procedure rezolva;
var i,x,y,a,b:longword;
    rez:int64;
begin
prepare;
assign(output,'minuni.out');rewrite(output);
for i:=1 to m do
 begin
 if ind[i]=0 then rez:=strazi[i].x*(n-strazi[i].y+1)
  else
   begin
   x:=strazi[i].x;
   y:=strazi[i].y;
   a:=strazi[ind[i]].x;
   b:=strazi[ind[i]].y;
   rez:=(x*(b-y)+(x-a)*(n-y+1)-(x-a)*(b-y));
   end;
 writeln(rez);
 end;
close(output);
end;

begin
citeste;
heapsort;
rezolva;
end.