Cod sursa(job #39309)

Utilizator andrewgPestele cel Mare andrewg Data 26 martie 2007 17:02:56
Problema Ograzi Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.06 kb
const maxn = 50002;
      maxm = 100002;

type punct = record
        x,y:longint;
     end;

var f:text;
    n,m,k,k1,p,q,i,j,sol,mid,poz:longint;
    a:array[1..maxn]of punct;
    b:array[1..maxm]of punct;
    c:array[1..maxn]of longint;

procedure readdata;
begin
   sol:=0;
   assign(f,'ograzi.in');
   reset(f);
   readln(f,n,m,p,q);
   for i:=1 to n do
   begin
      readln(f,a[i].x,a[i].y);
   end;
   for i:=1 to m do
   begin
      readln(f,b[i].x,b[i].y);
   end;
   close(f);
end;

procedure sort(l,r:longint);
var i,j,x:longint;
    y:punct;
begin
   i:=l;
   j:=r;
   x:=a[(l+r) div 2].x;
   repeat
      while a[i].x<x do i:=i+1;
      while x<a[j].x do j:=j-1;
      if i<=j then
      begin
         y:=a[i];
         a[i]:=a[j];
         a[j]:=y;
         i:=i+1;
         j:=j-1;
      end;
   until i>j;
   if l<j then sort(l,j);
   if i<r then sort(i,r);
end;

procedure sort1(l,r:longint);
var i,j,x:longint;
    y:punct;
begin
   i:=l;
   j:=r;
   x:=a[(l+r) div 2].y;
   repeat
      while a[i].y<x do i:=i+1;
      while x<a[j].y do j:=j-1;
      if i<=j then
      begin
         y:=a[i];
         a[i]:=a[j];
         a[j]:=y;
         i:=i+1;
         j:=j-1;
      end;
   until i>j;
   if l<j then sort1(l,j);
   if i<r then sort1(i,r);
end;

procedure search(x,y:longint);
begin
   mid:=(x+y) div 2;
   if x+1>=y then
   begin
      if (c[x]<>0) and (a[x].x>=k) and (a[x].x<=k+p) then
      begin
         mid:=x;
         exit;
      end
         else
      begin
         if x=y then
         begin
            mid:=-1;
            exit;
         end;
      end;
   end;
   if a[mid].x<k then search(mid+1,y)
                 else search(x,mid);
end;

procedure search1(x,y:longint);
begin
   mid:=(x+y) div 2;
   if x+1>=y then
   begin
      if (a[x].y>=k) and (a[x].y<=k+q) then
      begin
         mid:=x;
         exit;
      end
         else
      begin
         if x=y then
         begin
            mid:=-1;
            exit;
         end;
      end;
   end;
   if a[mid].y<k then search1(mid+1,y)
                 else search1(x,mid);
end;

procedure solve;
begin
   sort(1,n);
   i:=1;
   while i<n do
   begin
      j:=1;
      while (a[i].x=a[i+j].x) do inc(j);
      if j<>1 then sort1(i,i+j-1);
      c[i]:=j;
      i:=i+j;
      if i>=n then
      begin
         c[i]:=j;
         break;
      end;
   end;
   for i:=1 to m do
   begin
      k:=b[i].x-p;
      search(1,m);
      poz:=mid;
      k1:=k;
      if poz<>-1 then
      begin
         while (a[poz].x>=k1) and (a[poz].x<=k1+p) do
         begin
            k:=b[i].y-q;
            search1(poz,poz+c[poz]-1);
            if mid<>-1 then
            begin
               inc(sol);
               break;
            end;
            poz:=poz+c[poz];
         end;
      end;
   end;
end;

procedure writedata;
begin
   assign(f,'ograzi.out');
   rewrite(f);
   writeln(f,sol);
   close(f);
end;

begin
   readdata;
   solve;
   writedata;
end.