Cod sursa(job #139068)

Utilizator CezarMocanCezar Mocan CezarMocan Data 19 februarie 2008 17:57:50
Problema Trapez Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.26 kb
type punct=record
                x,y:longint;
                end;
var n,i,j,t,nr,rez,cd,p,q:longint;
    v:array[1..1010] of punct;
    x:array[1..10001] of punct;
    aux:punct;

function cmmdc(a,b:longint):longint;
var r:longint;
begin
if b=0 then
        begin
        cmmdc:=a;
        exit;
        end;
if a=0 then
        begin
        cmmdc:=b;
        exit;
        end;
r:=a mod b;
while r<>0 do
        begin
        a:=b;
        b:=r;
        r:=a mod b;
        end;
cmmdc:=b;
end;

procedure qsort(ls,ld:longint);
var i,j:longint;
begin
  i:=ls;j:=ld;
  while true do begin
    while ((v[i].x<v[j].x)or((v[i].x=v[j].x)and(v[i].y<=v[j].y)))and(i<>j) do inc(i);
    if i=j then break;
    aux:=v[i];v[i]:=v[j];v[j]:=aux;dec(j);
    while ((v[i].x<v[j].x)or((v[i].x=v[j].x)and(v[i].y<=v[j].y)))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].y<>x[j].y)and(x[i].x<>x[j].x) then
                begin
                inc(t);
                v[t].x:=x[i].y-x[j].y;
                v[t].y:=x[i].x-x[j].x;
                cd:=cmmdc(abs(v[t].x),abs(v[t].y));
                v[t].x:=v[t].x div cd;
                v[t].y:=v[t].y div cd;
                if (v[t].x<0)and(v[t].y<0) then
                        begin
                        v[t].x:=-v[t].x;
                        v[t].y:=-v[t].y;
                        end;
                end
                else
                        begin
                        if x[i].x=x[j].x then
                                inc(p)
                        else
                                inc(q);
                        end;
qsort(1,t);
i:=1;
while i<=t do
        begin
        j:=i;
        while (v[j].x=v[i].x)and(v[j].y=v[i].y)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.