Cod sursa(job #288218)

Utilizator wladVlad Mariasiu wlad Data 25 martie 2009 17:20:00
Problema Triang Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.16 kb
    var x,y:array[1..1500] of real;
        z:array[1..1000] of real;
        i,j,k,n,p,nrt:longint;
        m:real;

    procedure sort;
        var i:integer;
           ok:boolean;
            t:real;
            begin
        repeat
        ok:=FALSE;
        for i:=1 to k-1 do
         if z[i]>z[i+1] then begin
                     t:=z[i+1];
                     z[i+1]:=z[i];
                     z[i]:=t;
                     ok:=TRUE;
                     end;
       until ok=FALSE;
      end;

       begin
       assign(input,'triang.in'); reset(input);
       assign(output,'triang.out'); rewrite(output);
     readln(n);
       for i:=1 to n do read(x[i],y[i]);

     for i:=1 to n do
      for j:=i+1 to n do begin
        inc(k);
         z[k]:=sqrt(sqr(x[i]-x[j])+sqr(y[i]-y[j]));
         end;
        sort;
        m:=z[1];
        for i:=2 to k do if z[i]=m then inc(p)
                     else begin
                      m:=z[i];
                      nrt:=nrt+((p-2)*(p-1)*p) div 6;
                       p:=0;
                       end;
      write(nrt);
      readln;
      close(input); close(output);
      end.