Cod sursa(job #25583)

Utilizator vladcyb1Vlad Berteanu vladcyb1 Data 4 martie 2007 13:00:52
Problema Ograzi Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.62 kb
  {$I-,Q-,R-,S-}

 const nmax= 50010;

 type
      punct = record x,y:longint; end;
      sir = array[1..nmax]of punct;
      list = array[1..nmax]of longint;
      arbore = array[0..17]of list;

 var p, o : sir;
     T : arbore;
     x, ind : list;
     n, m, i , j ,k , test, x1, x2, y1, y2, rez, W, H, ans :longint;
     f,g:text;

 function search(var a : list; l, r, v : longint ):longint; inline;
 var step, p:longint;
 begin
 if (v < a[l]) then begin search:=l-1; exit; end;

 step:=1;
 while step<(r-l+1) do step:= step shl 1;
  p:=l;
  while step>0  do begin
    if (p+step<=r)and(a[p+step]<=v)then
                inc(p,step);
     step:= step shr 1;
  end; search:=p; end;


 procedure build( lv, l, r : longint);
 var juma:longint;
 begin
  if l=r then T[lv][l]:=p[ind[l]].y
  else begin
   juma:=(l+r) div 2;
   build(lv+1,l,juma);
   build(lv+1,juma+1,r);
   {acuma pt intervalul [l,r] tre sa fac interclasare fiilor stanga si dreapta}
   i:=l; j:=juma+1; k:=l-1;
   while (i<=juma)and(j<=r) do
    if t[lv+1][i]<t[lv+1][j] then begin inc(k); t[lv][k]:=t[lv+1][i]; i:=i+1; end
                             else begin inc(k); t[lv][k]:=t[lv+1][j]; j:=j+1; end;
   while i<=juma do begin inc(k); t[lv][k]:=t[lv+1][i]; i:=i+1; end;
   while j<=r do begin inc(k); t[lv][k]:=t[lv+1][j]; j:=j+1; end;
   end;
 end;

 procedure query( lv, l, r : longint);
 var juma:longint;
 begin
 if (x1<=l)and(x2>=r) then
   begin
   if (y1<=t[lv][l]) and (y2>=t[lv][r]) then rez:=rez+r-l+1
         else rez:=rez+search(t[lv],l,r,y2)-search(t[lv],l,r,y1-1);
   end
   else begin
    juma:=(l+r)div 2;
    if x1<=juma then query(lv+1,l,juma);
    if x2>juma  then query(lv+1,juma+1,r);
    end;
 end;

 procedure poz(li,lo:longint);
 var i, j, di, dj, aux : longint;
 begin
  i:=li; j := lo; di := 0; dj := - 1;
  while i < j do
   begin
   if p[ind[i]].x>p[ind[j]].x then begin aux:=ind[i]; ind[i]:=ind[j]; ind[j]:=aux;
                                         aux:=di; di:=-dj; dj:=-aux;
                                   end;
   inc( i, di ); inc( j, dj );
  end;
 k:=i;
 end;

 procedure quick(li,lo:longint);
 begin
 poz(li,lo);
 if li<lo then
  begin
  quick(li,k-1);
  quick(k+1,lo);
  end;
 end;

 procedure citire;
  var s : string;
      i, j : longint;
 begin
 assign(f,'ograzi.in'); reset(f);
 readln( f, M, N, W, H );
 for j := 1 to M do
  begin
    readln( f, s );
    o[j].x := 0; o[j].y := 0; i := 1;
    while s[i] <> ' ' do
      begin
       o[j].x := o[j].x * 10 + ord(s[i]) - 48 ;
       i := i + 1;
      end;
    i := i + 1;
    while (i <= length( s )) and ( ord(S[i]) > 47 ) and ( ord(s[i]) < 58 ) do
      begin
      o[j].y := o[j].y * 10 + ord( s[i] ) - 48;
      i := i + 1;
      end;
  end;

   for j := 1 to N do
  begin
    readln( f, s );
    p[j].x := 0; p[j].y := 0; i := 1;
    ind[j] := j;
    while s[i] <> ' ' do
      begin
       p[j].x := p[j].x * 10 + ord(s[i]) - 48 ;
       i := i + 1;
      end;
    i := i + 1;
    while (i <= length( s )) and ( ord(S[i]) > 47 ) and ( ord(s[i]) < 58 ) do
      begin
      p[j].y := p[j].y * 10 + ord( s[i] ) - 48;
      i := i + 1;
      end;
  end;
 quick(1,n);
 end;

 begin
 citire;
 for i:=1 to n do x[i]:=p[ind[i]].x;
 build(0,1,n);
 assign(g,'ograzi.out'); rewrite(g);
 ans := 0;
 for test:=1 to M do
  begin
  x1 := o[test].x; y1 := o[test].y;
  x2 := x1 + W; y2 := y1 + H;
  if not((x2<x[1])or(x1>x[n])) then
  begin
  x1:=search(x,1,n,x1-1)+1;
  x2:=search(x,1,n,x2);
  rez:=0;
  query(0,1,n);
  ans := ans + rez;
  end;
  end;
 writeln( g, ans );
 close(g);
end.