Cod sursa(job #8547)

Utilizator VmanDuta Vlad Vman Data 24 ianuarie 2007 22:53:04
Problema Patrate 3 Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.97 kb
program patrate3;
const hsize=1000;
var n,i,j,k,key:integer;
    x,y:array[1..hsize]of real;
    nr:array[1..hsize]of byte;
    hash:array[1..hsize+1,1..30]of integer;
    f:text;
    a,mx,my,dx,dy,xx,yy,eps:real;
    ok:boolean;
    total:longint;
label 1,2;
begin
eps:=0.0001;
assign(f,'patrate3.in');reset(f);
readln(f,n);
a:=(sqrt(5)-1)/2;
for i:=1 to n do begin
    readln(f,x[i],y[i]);
    key:=trunc(abs(frac((x[i]+y[i])*a))*hsize);
    inc(nr[key]);
    hash[key][nr[key]]:=i;
end;
for i:=1 to n-1 do
    for j:=i+1 to n do
        begin
             mx:=(x[i]+x[j])/2;
             my:=(y[i]+y[j])/2;
             dx:=abs(x[i]-mx);
             dy:=abs(y[i]-my);
             if (x[i]-x[j])/(y[i]-y[j])>=0 then begin
                               xx:=mx+dy;
                               yy:=my-dx;
                               key:=trunc(abs(frac((xx+yy)*a))*hsize);
                               ok:=false;
                               for k:=1 to nr[key] do
                                   if (abs(x[hash[key][k]]-xx)<eps)and(abs(y[hash[key][k]]-yy)<eps)
                                      then begin ok:=true;break;end;
                               if not ok then goto 1;
                               xx:=mx-dy;
                               yy:=my+dx;
                               key:=trunc(abs(frac((xx+yy)*a))*hsize);
                               ok:=false;
                               for k:=1 to nr[key] do
                                   if (abs(x[hash[key][k]]-xx)<eps)and(abs(y[hash[key][k]]-yy)<eps)
                                      then begin ok:=true;break;end;
                               if not ok then goto 1;
                               inc(total);
                               1:
                               end
               else  begin
                               xx:=mx+dy;
                               yy:=my+dx;
                               key:=trunc(abs(frac((xx+yy)*a))*hsize);
                               ok:=false;
                               for k:=1 to nr[key] do
                                   if (abs(x[hash[key][k]]-xx)<eps)and(abs(y[hash[key][k]]-yy)<eps)
                                      then begin ok:=true;break;end;
                               if not ok then goto 2;
                               xx:=mx-dy;
                               yy:=my-dx;
                               key:=trunc(abs(frac((xx+yy)*a))*hsize);
                               ok:=false;
                               for k:=1 to nr[key] do
                                   if (abs(x[hash[key][k]]-xx)<eps)and(abs(y[hash[key][k]]-yy)<eps)
                                      then begin ok:=true;break;end;
                               if not ok then goto 2;
                               inc(total);
                               2:
                               end;

         end;
assign(f,'patrate3.out');rewrite(f);
write(f,total div 2);
close(f);
end.