Cod sursa(job #5145)

Utilizator VmanDuta Vlad Vman Data 10 ianuarie 2007 19:44:54
Problema Triang Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.42 kb
program triang;
const hsize=1000;
      eps=0.001;
var n,i,j,key,k:integer;
    total:longint;
    d,h,xc,yc,xx,yy,a,rad3:real;
    x,y:array[1..1500]of real;
    hash:array[0..hsize+1,0..100]of integer;
    f:text;
begin
a:=(sqrt(5)-1)/2;
rad3:=sqrt(3);
assign(f,'triang.in');reset(f);
readln(f,n);
for i:=1 to n do begin
    readln(f,x[i],y[i]);
    key:=abs(trunc(frac(a*(x[i]+y[i]))*hsize));
    inc(hash[key][0]);
    hash[key][hash[key][0]]:=i;
end;
close(f);

for i:=1 to n-1 do
    for j:=i+1 to n do
        begin
        d:=sqrt((x[i]-x[j])*(x[i]-x[j])+(y[i]-y[j])*(y[i]-y[j]));
        h:=d*rad3/2;
        xc:=(x[i]+x[j])/2;
        yc:=(y[i]+y[j])/2;
        {primul punct}
        xx:=xc+((2/d)*(y[i]-yc)*h);
        yy:=yc-((2/d)*(x[i]-xc)*h);
          {caut}
          key:=abs(trunc(frac(a*(xx+yy))*hsize));
          for k:=1 to hash[key][0] do
              if (hash[key][k]>j)and(abs(x[hash[key][k]]-xx)<eps)and(abs(y[hash[key][k]]-yy)<eps) then
                 inc(total);
        {al 2-lea punct}
        xx:=xc-(2/d)*(y[i]-yc)*h;
        yy:=yc+(2/d)*(x[i]-xc)*h;
          {caut}
          key:=abs(trunc(frac(a*(xx+yy))*hsize));
          for k:=1 to hash[key][0] do
              if (hash[key][k]>j)and(abs(x[hash[key][k]]-xx)<eps)and(abs(y[hash[key][k]]-yy)<eps) then
                 inc(total);
       end;
assign(f,'triang.out');rewrite(f);
write(f,total);
close(f);
end.