Cod sursa(job #25311)

Utilizator fogabFodor Gabor fogab Data 4 martie 2007 11:54:58
Problema Ograzi Scor 10
Compilator fpc Status done
Runda preONI 2007, Runda 3, Clasele 11-12 Marime 1.56 kb
var f:text;
    a:array[1..2,0..50001] of longint;
    sol,n,m,i,i2,w,h,x,y,a1,a2,b1,b2:longint;
    b:array[0..50001] of longint;

procedure quicksort(l,r:dword);
var i,j:dword;
    x,y,h:longint;
begin
 i:=l;j:=r;x:=a[1,(l+r) div 2];y:=a[2,(l+r) div 2];
 repeat
   while (a[1,i]<x) or ((a[1,i]=x) and (a[2,i]<y)) do inc(i);
   while (x<a[1,j]) or ((a[1,j]=x) and (y<a[2,j])) do dec(j);
   if i<=j then begin
                h:=a[1,i];
                a[1,i]:=a[1,j];
                a[1,j]:=h;
                h:=a[2,i];
                a[2,i]:=a[2,j];
                a[2,j]:=h;
                inc(i);
                dec(j);
                end;
 until i>j;
 if l<j then quicksort(l,j);
 if i<r then quicksort(i,r);
end;

begin
sol:=0;
assign(f,'ograzi.in');
reset(f);
readln(f,n,m,w,h);
for i:=1 to n do
  readln(f,a[1,i],a[2,i]);
quicksort(1,n);
a[1,0]:=-2147483646;
a[2,0]:=-2147483646;
a[1,n+1]:=2147483646;
a[2,n+1]:=2147483646;
for i:=1 to m do
  begin
    readln(f,x,y);
    a1:=0;
    a2:=n+1;
    while a2-a1>1 do
     if (x>=a[1,(a1+a2) div 2]) then a2:=(a1+a2) div 2
        else a1:=(a1+a2) div 2;
    b1:=a1;
    a2:=n+1;
    while a2-a1>1 do
     if (x<a[1,(a1+a2) div 2]) then a2:=(a1+a2) div 2
        else a1:=(a1+a2) div 2;
    b2:=a2;
    for i2:=b1 to b2 do
    if (a[1,i2]<=x) and (a[1,i2]+w>=x)
    and (a[2,i2]<=y) and (a[2,i2]+h>=y)
    then begin
         inc(sol);
         writeln(i);
         break;
         end;
  end;
close(f);
assign(f,'ograzi.out');
rewrite(f);
writeln(f,sol);
close(f);
end.