Cod sursa(job #237789)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 30 decembrie 2008 19:03:06
Problema Triang Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.91 kb
program alex;
var f:text;
    a,b,c:array[1..1500]of extended;
    i,n,k,j,v,d,x,z,m:longint;
    q:extended;
    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
        for h:=j+1 to k do
            if abs(c[i]-c[h]<0.001 then d:=d+1;
       { 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.