Cod sursa(job #237782)
Utilizator | Data | 30 decembrie 2008 18:49:01 | |
---|---|---|---|
Problema | Triang | Scor | 0 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 1.82 kb |
program alex;
var f:text;
a,b,c:array[1..1500]of real;
i,n,k,j,v,d,x,z,m:longint;
q:real;
e:boolean;
begin
assign(f,'triang.in');reset(f);
readln(f,n);
for i:=1 to n do
readln(f,a[i],b[i]);
close(f);
k:=0;
for i:=1 to n-1 do
for j:=i+1 to n do
begin
k:=k+1;
c[k]:=sqrt(sqr(a[i]-a[j])+sqr(b[i]-b[j]));
end;
v:=1;
e:=true;
while e=true do
begin
e:=false;
for i:=1 to k-v do
if c[i]>c[i+1] then begin
q:=c[i];
c[i]:=c[i+1];
c[i+1]:=q;
e:=true;
end;
v:=v+1;
end;
d:=0;
for i:=1 to k-2 do
for j:=i+1 to k-1 do
if abs(c[i]-c[j])<0.001 then begin
x:=j+1;
z:=k;
m:=(x+z) div 2;
e:=false;
while x<=z do
begin
e:=true;
if abs(c[i]-c[m])>0.001 then begin
z:=m-1;
m:=(z+x)div 2;
end
else begin
x:=m+1;
m:=(x+z) div 2;
end;
end;
if e=true then d:=d+(m-j);
end;
assign(f,'triang.out');rewrite(f);
writeln(f,d);
close(f);
end.