Cod sursa(job #6996)

Utilizator petrePajarcu Alexandru-Petrisor petre Data 21 ianuarie 2007 11:34:13
Problema Pachete Scor 10
Compilator fpc Status done
Runda preONI 2007, Runda 1, Clasa a 10-a Marime 1.33 kb
program ns;
var f,g:text;
a,dr:array[1..50000,1..2] of longint;
b,drd:array[1..50000] of longint;
n,i,j,k,l,m,x,y:longint;
ok:boolean;
procedure Sort(l, r: longint);
var
  i, j, x, y: longint;
begin
  i := l; j := r; x := b[(l+r) DIV 2];
  repeat
    while b[i] < x do i := i + 1;
    while x < b[j] do j := j - 1;
    if i <= j then
    begin
      y := b[i]; b[i] := b[j]; b[j] := y;
      y:=a[i,1];a[i,1]:=a[j,1];a[j,1]:=y;
      y:=a[i,2];a[i,2]:=a[j,2];a[j,2]:=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;

begin
assign(f,'pachete.in');
assign(g,'pachete.out');
reset(f);
rewrite(g);
readln(f,n);
readln(f,x,y);
for i:=1 to n do
        begin
        readln(f,a[i,1],a[i,2]);
        b[i]:=abs(x-a[i,1])+abs(y-a[i,2]);
        end;
sort(1,n);
k:=1;
dr[k,1]:=a[1,1];
dr[k,2]:=a[1,2];drd[k]:=b[1];
for i:=2 to n do
begin
ok:=true;
        for j:=1 to k do
if abs(a[i,1]-dr[j,1])+abs(a[i,2]-dr[j,2])=b[i]-drd[j] then
        begin
        dr[j,1]:=a[i,1];
        dr[j,2]:=a[i,2];
        drd[j]:=b[i];
        ok:=false;
        break;
        end;
if ok then
        begin
        k:=k+1;
        dr[k,1]:=a[i,1];
        dr[k,2]:=a[i,2];
        drd[k]:=b[i];
        end;
end;
writeln(g,k);
close(f);
close(g);
end.