Cod sursa(job #119020)

Utilizator m123pop manu m123 Data 29 decembrie 2007 08:44:59
Problema Trapez Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.14 kb
program trapez;
var f,g:text;
   n,i,j,ox,oy,nr,k,l:integer;
   a,b:longint;
   x,y,c,d:array[1..1000] of longint;
begin
assign(f,'trapez.in');reset(f);
assign(g,'trapez.out');rewrite(g);
readln(f,n);
for i:=1 to n do
  readln(f,x[i],y[i]);
ox:=0;oy:=0;k:=0;
for i:=1 to n-1 do
  for j:=i+1 to n do
    if x[i]-x[j]=0 then oy:=oy+1
      else if y[i]-y[j]=0 then ox:=ox+1
       else begin k:=k+1;a:=y[i]-y[j];b:=x[i]-x[j];
                  if(( a<0) and ( b<0)) or(( a>0) and ( b<0))
                          then begin c[k]:=-a;d[k]:=-b end
                          else begin c[k]:=a ; d[k]:=b; end;
             end;
n:=k;
repeat
k:=0;
for i:=1 to n-1 do
   if c[i]*d[i+1]>c[i+1]*d[i] then begin k:=1;
                                  a:=c[i];c[i]:=c[i+1];c[i+1]:=a;
                                  a:=d[i];d[i]:=d[i+1];d[i+1]:=a;
                                  end;
until k=0;
nr:=(ox*(ox-1)) div 2 +(oy*(oy-1)) div 2   ;
i:=1;
while i<n do
begin
l:=1;
while (c[i]*d[i+1]=c[i+1]*d[i]) and (i<n) do begin l:=l+1;i:=i+1;end;
if l>2 then nr:=nr+ (l*(l-1)) div 2;
i:=i+1;
end;
writeln(g,nr);
close(f);close(g);
end.