Cod sursa(job #139027)

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

function cmmdc(a,b:longint):longint;
var r:longint;
begin
if b=0 then
        begin
        cmmdc:=a;
        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
                begin
                inc(t);
                v[t].x:=x[i].y-x[j].y;
                v[t].y:=x[i].x-x[j].x;
                cd:=cmmdc(v[t].x,v[t].y);
                v[t].x:=v[t].x div cd;
                v[t].y:=v[t].y div cd;
                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(nr);
close(input);close(output);
end.