Cod sursa(job #11771)

Utilizator fogabFodor Gabor fogab Data 1 februarie 2007 17:03:32
Problema Trapez Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.9 kb
var a,b:array[1..1000] of longint;
    c1,c2:array[1..1000000] of int64;
    i,n,sol,j,l:longint;
    h:int64;
    f:text;
function cmmdc(a,b:int64):int64;
var c:int64;
begin
while b<>0 do
  begin
    c:=a mod b;
    a:=b;
    b:=c;
  end;
cmmdc:=a;
end;
procedure quicksort(l,r:dword);
var i,j:dword;
    x,x2,y:int64;
begin
 i:=l;j:=r;x:=c1[(l+r) div 2];x2:=c2[(l+r) div 2];
 repeat
   while (c1[i]<x) or ((c1[i]=x) and (c2[i]<x2)) do i:=i+1;
   while (c1[j]>x) or ((c1[j]=x) and (c2[j]>x2)) do j:=j-1;
   if i<=j then begin
                y:=c1[i];
                c1[i]:=c1[j];
                c1[j]:=y;
                y:=c2[i];
                c2[i]:=c2[j];
                c2[j]:=y;
                i:=i+1;
                j:=j-1;
                end;
 until i>j;
 if l<j then quicksort(l,j);
 if i<r then quicksort(i,r);
end;

begin
cmmdc(-20,30);
assign(f,'trapez.in');
reset(f);
readln(f,n);
for i:=1 to n do begin
                 readln(f,a[i],b[i]);
                 end;
close(f);
l:=0;
for i:=1 to n-1 do
   for j:=i+1 to n do begin
                      inc(l);
                      c1[l]:=a[i]-a[j];
                      c2[l]:=b[i]-b[j];
                      h:=cmmdc(abs(c1[l]),abs(c2[l]));
                      c1[l]:=c1[l] div h;
                      c2[l]:=c2[l] div h;
                      if c2[l]<0 then begin
                                      c1[l]:=-1*c1[l];
                                      c2[l]:=c2[l]*-1;
                                      end;
                      end;
quicksort(1,l);
sol:=0;
j:=1;
for i:=2 to l do
  begin
  if (c1[i]=c1[i-1])
  and (c2[i]=c2[i-1]) then begin
                           inc(j);
                           sol:=sol+j-1;
                           end
      else begin
           j:=1;
           end;
  end;
assign(f,'trapez.out');
rewrite(f);
writeln(f,sol);
close(f);
end.