Cod sursa(job #1147269)

Utilizator braisaMiron Raisa braisa Data 19 martie 2014 18:26:28
Problema Trapez Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.17 kb
program puncte;
type point =record
           x,y:longint;
           end;
var a:array[1..1000] of point;
     b:array[1..1000000] of real;
     c:array[1..1000000] of longint;
   n,i,j,k,h:longint;
   m:real;
 procedure qsort(l,r:longint);
 var i,j:longint;
     m,aux:real;
 begin
 i:=l;
 j:=r;
 m:=b[(i+j)div 2];
 while i<=j do begin
    while b[i]<m do inc(I);
    while b[j]>m  do dec(j);
    if i<=j  then begin
                 aux:=b[i];
                 b[i]:=b[j];
                 b[j]:= aux;
                 inc(i);
                 dec(j);
                 end;
    end;
 if i<r then qsort(i,r);
 if l<j then qsort(l,j);
end;
begin
  assign(input,'trapez.in'); reset(input);
  assign(output,'trapez.out'); rewrite(output);
  readln(n);
  h:=0;
  for i:=1 to n do readln(a[i].x,a[i].y);
  for i:=1 to n-1 do
    for j:=i+1 to n do
     begin
     if a[j].x-a[i].x=0 then m:=1 shl 15 else
     m:=((a[j].y-a[i].y)/(a[j].x-a[i].x));
     inc(h);
     b[h]:=m;
     end;

  qsort(1,h);
  k:=0;
  for i:=1 to h do c[i]:=0;
  for i:=2 to h do
    if b[i]=b[i-1] then begin c[i]:=c[i-1]+1; inc(k,c[i]); end;
  write(k);
  close(output);
end.