Cod sursa(job #14777)

Utilizator VmanDuta Vlad Vman Data 9 februarie 2007 19:04:54
Problema Pachete Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.43 kb
program pachete;
const nmax=50000;
type punct=record
                 x,y:longint;
           end;
     cadran=array[1..nmax]of word;
var c1,c2,c3,c4:cadran;
    p:array[1..nmax]of punct;
    x0,y0,xx,yy,i,l,nr:longint;
    n,nr1,nr2,nr3,nr4,first:word;
    exista:boolean;
    f:text;


procedure citire;
begin
assign(f,'pachete.in');reset(f);
readln(f,n);
readln(f,x0,y0);
for i:=1 to n do begin
    readln(f,p[i].x,p[i].y);
    {cadranu 1}
    if (p[i].x<x0)and(p[i].y>y0) then
       begin
       inc(nr1);
       c1[nr1]:=i;
       end
    else
    {cadranu 2}
    if (p[i].x<x0)and(p[i].y<y0) then
       begin
       inc(nr2);
       c2[nr2]:=i;
       end
    else
    {cadranu 3}
    if (p[i].x>x0)and(p[i].y<y0) then
       begin
       inc(nr3);
       c3[nr3]:=i;
       end
    else
    {cadranu 4}
       begin
       inc(nr4);
       c4[nr4]:=i;
       end;
end;
close(f);
end;

procedure qsort(l, r: word;var c:cadran);
var
  i, j, m, y: longint;
begin
  i := l; j := r; m := p[c[(l+r) DIV 2]].x;
  repeat
    while p[c[i]].x < m do i := i + 1;
    while m < p[c[j]].x do j := j - 1;
    if i <= j then
    begin
      y := c[i]; c[i] := c[j]; c[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then qsort(l, j, c);
  if i < r then qsort(i, r, c);
end;


begin
citire;
nr:=0;
{cadranu 1}
if nr1<>0 then qsort(1,nr1,c1);
first:=1;
while true do begin
      i:=first;
      while (c1[i]=0)and(i<=nr1) do
            inc(i);
      if i>nr1 then break;
      l:=c1[i];
      inc(nr);
      c1[i]:=0;
      inc(i);
      first:=i;
      while i<=nr1 do begin
            if (c1[i]<>0)and(p[c1[i]].x<=p[l].x)and(p[c1[i]].y>=p[l].y)
               then begin
                    l:=c1[i];
                    c1[i]:=0;
                    end;
      inc(i);
      end;
end;
{cadranu 2}
if nr2<>0 then qsort(1,nr2,c2);
first:=1;
while true do begin
      i:=first;
      while (c2[i]=0)and(i<=nr2) do
            inc(i);
      if i>nr2 then break;
      l:=c2[i];
      inc(nr);
      c2[i]:=0;
      inc(i);
      first:=i;
      while i<=nr2 do begin
            if (c2[i]<>0)and(p[c2[i]].x<=p[l].x)and(p[c2[i]].y<=p[l].y)
               then begin
                    l:=c2[i];
                    c2[i]:=0;
                    end;
      inc(i);
      end;
end;
{cadranu 3}
if nr3<>0 then qsort(1,nr3,c3);
first:=1;
while true do begin
      i:=first;
      while (c3[i]=0)and(i<=nr3) do
            inc(i);
      if i>nr3 then break;
      l:=c3[i];
      inc(nr);
      c3[i]:=0;
      inc(i);
      first:=i;
      while i<=nr3 do begin
            if (c3[i]<>0)and(p[c3[i]].x>=p[l].x)and(p[c3[i]].y<=p[l].y)
               then begin
                    l:=c3[i];
                    c3[i]:=0;
                    end;
      inc(i);
      end;
end;
{cadranu 4}
if nr4<>0 then qsort(1,nr4,c4);
first:=1;
while true do begin
      i:=first;
      while (c4[i]=0)and(i<=nr4) do
            inc(i);
      if i>nr4 then break;
      l:=c4[i];
      inc(nr);
      c2[i]:=0;
      inc(i);
      first:=i;
      while i<=nr4 do begin
            if (c4[i]<>0)and(p[c4[i]].x>=p[l].x)and(p[c4[i]].y>=p[l].y)
               then begin
                    l:=c4[i];
                    c4[i]:=0;
                    end;
      inc(i);
      end;
end;

assign(f,'pachete.out');rewrite(f);
write(f,nr);
close(f);
end.