Cod sursa(job #139078)

Utilizator CezarMocanCezar Mocan CezarMocan Data 19 februarie 2008 18:12:15
Problema Trapez Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.57 kb
type punct=record
                x,y:longint;
                end;
var n,i,j,t,nr,rez,cd,p,q:longint;
    x:array[1..1010] of punct;
    v:array[1..500001] of double;
    aux:double;


function egal(a,b:double):longint;
begin
if abs(a-b)<0.0000000000001 then
        begin
        egal:=0;
        exit;
        end;
if a-b<0 then
        begin
        egal:=-1;
        exit;
        end;
egal:=1;
end;

procedure qsort(ls,ld:longint);
var i,j:longint;
begin
  i:=ls;j:=ld;
  while true do begin
    while (egal(v[i],v[j])=-1)and(i<>j) do inc(i);
    if i=j then break;
    aux:=v[i];v[i]:=v[j];v[j]:=aux;dec(j);
    while (egal(v[i],v[j])=-1)and(i<>j) do dec(j);
    if i=j then break;
    aux:=v[i];v[i]:=v[j];v[j]:=aux;inc(i);
  end;
  if j-1>ls then qsort(ls,j-1);
  if j+1<ld then qsort(j+1,ld);
end;


begin
assign(input,'trapez.in');reset(input);
assign(output,'trapez.out');rewrite(output);
readln(n);
for i:=1 to n do
        readln(x[i].x,x[i].y);
for i:=1 to n-1 do
        for j:=i+1 to n do
                if (x[i].x<>x[j].x) then
                        begin
                        inc(t);
                        v[t]:=(x[i].y-x[j].y)/(x[i].x-x[j].x);
                        end
                else
                        inc(p);
qsort(1,t);
i:=1;
while i<=t do
        begin
        j:=i;
        while (egal(v[j],v[i])=0)and(j<=t) do
                inc(j);
        nr:=j-i;
        rez:=rez+nr*(nr-1) div 2;
        i:=j;
        end;
writeln(rez+p*(p-1) div 2+q*(q-1) div 2);
close(input);close(output);
end.