Cod sursa(job #61607)

Utilizator vanila0406Ionescu Victor vanila0406 Data 20 mai 2007 00:04:10
Problema Patrate 3 Scor 5
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.5 kb
program patrate3;
type coord=record
        x,y:longint;
end;
var f,g:text;
        v:array[1..1001] of coord;
        n:longint;




procedure iofile;
var i:longint;
        vx,vy,j:longint;
        s:string;
begin
        assign(f,'patrate3.in');
        reset(f);
        assign(g,'patrate3.out');
        rewrite(g);
        readln(f,n);
        for j:=1 to n do
                begin
                        readln(f,s);
                        vx:=0;
                        vy:=0;
                        for i:=1 to length(s) do
                                if s[i]=' ' then break else
                                if s[i] in ['0'..'9'] then
                                vx:=vx*10+ord(s[i])-ord('0');
                        vx:=vx*10;
                        v[j].x:=vx;
                        vx:=i;
                        for i:=vx+1 to length(s) do
                                if s[i] in ['0'..'9'] then
                                    vy:=vy*10+ord(s[i])-ord('0');
                        vy:=vy*10;
                        v[j].y:=vy;
                end;
        close(f);
end;



procedure pozitie(var m:longint;p,u:longint);
var i,j,di,dj,aux:longint;
        aux1:coord;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
                begin
                        if (v[i].x>v[j].x)or(
                        (v[i].x=v[j].x)and(v[i].y>v[j].y))
                                then
                                        begin
                                                aux:=di;
                                                di:=-dj;
                                                dj:=-aux;
                                                aux1:=v[i];
                                                v[i]:=v[j];
                                                v[j]:=aux1;
                                        end;
                        i:=i+di;
                        j:=j+dj;
                end;
        m:=i;
end;


procedure quick(p,u:longint);
var m:longint;
begin
        if p<u then
                begin
                        pozitie(m,p,u);
                        quick(p,m-1);
                        quick(m+1,u);
                end;
end;


function cbin(p,u:longint;x,y:longint):byte;
var m:longint;
begin
        if p>u then cbin:=0 else
                begin
                        m:=(p+u) div 2;
                        if v[m].x=x then
                                begin
                                        if v[m].y=y then cbin:=1 else
                                                if v[m].y<y then
                                                cbin:=cbin(m+1,u,x,y) else
                                                cbin:=cbin(p,m-1,x,y);
                                end else
                                if v[m].x<x then
                                        cbin:=cbin(m+1,u,x,y) else
                                        cbin:=cbin(p,m-1,x,y);
                end;
end;

procedure prel;
var i,j:longint;
        mijx,mijy,dx,dy,x2,y2,x3,y3:longint;
        nrpat:longint;
begin
        quick(1,n);
        nrpat:=0;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                        begin
                                mijx:=(v[i].x+v[j].x) div 2;
                                mijy:=(v[i].y+v[j].y) div 2;
                                dx:=abs(mijx-v[i].x);
                                dy:=abs(mijy-v[i].y);
                                if v[i].y<v[j].y then
                                        begin
                                                x2:=mijx+dy;
                                                y2:=mijy-dx;
                                                x3:=mijx-dy;
                                                y3:=mijy+dx;
                                        end else
                                        begin
                                                x2:=mijx-dy;
                                                y2:=mijy-dx;
                                                x3:=mijx+dy;
                                                y3:=mijy+dx;
                                        end;
                                if (cbin(1,n,x2,y2)=1)and(cbin(1,n,x3,y3)=1) then
                                        inc(nrpat);
                        end;
        writeln(g,nrpat div 2);
        close(g);
end;



begin
        iofile;
        prel;
end.