Cod sursa(job #565915)

Utilizator andrei31Andrei Datcu andrei31 Data 28 martie 2011 14:01:25
Problema Zoo Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.93 kb
const nmax=16000;
type punct=record x,y:longint end;
var t:array[0..15,1..nmax] of longint;
    h:array[1..nmax] of punct;
    n:word;
    x1,y1,x2,y2:longint;
    buf1,buf2:array[1..300000] of byte;

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

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

procedure heapsort;
var i:word;
begin
for i:=n div 2 downto 1 do heapdw(i,n);
for i:=n downto 2 do
 begin
 swap(1,i);
 heapdw(1,i-1);
 end;
end;

procedure build(lv:word;l,r:word);
var m,i,j,k:word;
begin
if (l=r) then t[lv,l]:=h[l].y
 else
  begin
  m:=(l+r) shr 1;
  build(lv+1,l,m);
  build(lv+1,m+1,r);
  k:=l;i:=l;j:=m+1;
   while (i<=m) or (j<=r) do
    if (j>r) or ( (i<=m) and (t[lv+1,i]<t[lv+1,j])) then
     begin
     t[lv,k]:=t[lv+1,i];inc(i);inc(k);
     end
      else
       begin
       t[lv,k]:=t[lv+1,j];inc(j);inc(k);
       end;
   end;
end;

function cautas(lv:byte;l,r:word;v:longint):word;
var m,p:word;
begin
p:=l;
while l<=r do
 begin
 m:=(l+r) shr 1;
 if v<=t[lv,m] then begin r:=m-1;p:=m;end
  else l:=m+1;
 end;
if t[lv,p]<v then inc(p);
cautas:=p;
end;


function cautad(lv:byte;l,r:word;v:longint):word;
var m,p:word;
begin
p:=r;
while l<=r do
 begin
 m:=(l+r) shr 1;
 if v<t[lv,m] then r:=m-1 else begin l:=m+1;p:=m;end;
 end;
if t[lv,p]>v then dec(p);
cautad:=p;
end;

{function cauta(lv:byte;l,r:word;v:longint):word;
var m:word;
begin
cauta:=0;
while l<=r do
 begin
 m:=(l+r) shr 1;
 if t[lv,m]=v then
  begin
  cauta:=m;
  exit;
  end
   else
 if t[lv,m]<v then
  begin
  cauta:=m;
  l:=m+1;
  end    else r:=m-1;
 end;
if cauta=0 then cauta:=m;
end;   }

function query(lv:byte;l,r:word):word;
var tt,m:word;
begin
tt:=0;
 if (x1<=l) and (r<=x2) then
  begin
   if (y2<t[lv,l]) or (y1>t[lv,r]) then tt:=0
      else tt:=cautad(lv,l,r,y2)-cautas(lv,l,r,y1)+1;
   end
    else
     begin
     m:=(l+r) shr 1;
     if x1<=m then tt:=tt+query(lv+1,l,m);
     if m<x2  then tt:=tt+query(lv+1,m+1,r);
     end;
query:=tt;
end;

procedure citire;
var i,m:longword;
begin
assign(input,'zoo.in');settextbuf(input,buf1);reset(input);
readln(n);
for i:=1 to n do
 readln(h[i].x,h[i].y);
heapsort;
for i:=1 to n do
t[0,i]:=h[i].x;
build(1,1,n);
readln(m);
assign(output,'zoo.out');settextbuf(output,buf2);rewrite(output);
for i:=1 to m do
 begin
 readln(x1,y1,x2,y2);
 if (x2<h[1].x) or (x1>h[n].x) or (y2<t[1,1]) or (y1>t[1,n]) then writeln(0)
  else
   begin
   x1:=cautas(0,1,n,x1);
   x2:=cautad(0,1,n,x2);
   writeln(query(1,1,n));
   end;
 end;
close(input);close(output);
end;

begin
citire;
end.