Cod sursa(job #57218)

Utilizator cezar305Mr. Noname cezar305 Data 1 mai 2007 13:53:28
Problema Patrate 3 Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.58 kb
var c:char;
    caut1,caut2,i,j,n,nr,pos,m,aux,l1,l2:longint;
    x,y:array[1..1001] of longint;
    f1,f2:text;

procedure search(li,ls:integer);
begin
nr:=0;
m:=(li+ls) div 2;
if (caut1=x[m])and(caut2=y[m]) then nr:=1
        else if li<ls then if caut1<x[m] then search(li,m-1)
                else if (caut1=x[m])and(caut2<y[m]) then search(li,m-1)
                        else search(m+1,ls);
end;

begin
        assign(f1,'patrate3.in');
        reset(f1);
        assign(f2,'patrate3.out');
        rewrite(f2);
        readln(f1,n);
        for i:=1 to n do
        begin
                while c<>' ' do
                begin
                        read(f1,c);
                        if (c<>'.')and(c<>' ') then x[i]:=x[i]*10+ord(c)-48;
                end;
                while not eoln(f1) do
                begin
                        read(f1,c);
                        if c<>'.' then y[i]:=y[i]*10+ord(c)-48;
                end;
                readln(f1);
        end;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                begin
                        if x[i]>x[j] then
                        begin
                                aux:=x[i];
                                x[i]:=x[j];
                                x[j]:=aux;
                                aux:=y[i];
                                y[i]:=y[j];
                                y[j]:=aux;
                        end;
                        if (x[i]=x[j])and(y[i]>y[j]) then
                        begin
                                aux:=x[i];
                                x[i]:=x[j];
                                x[j]:=aux;
                                aux:=y[i];
                                y[i]:=y[j];
                                y[j]:=aux;
                        end;
                end;
        for i:=1 to n-3 do
                for j:=i+1 to n-2 do
                begin
                        l1:=abs(x[i]-x[j]);
                        l2:=abs(y[i]-y[j]);
                        caut1:=x[i]+l2;
                        if y[j]>y[i] then l1:=l1*-1;
                        caut2:=y[i]+l1;
                        search(j+1,n);
                        if nr=1 then
                        begin
                                caut1:=x[j]+l2;
                                caut2:=y[j]+l1;
                                search(j+1,n);
                                if nr=1 then inc(pos);
                        end;
                end;
        writeln(f2,pos);
        close(f1);
        close(f2);
end.