Cod sursa(job #139018)

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

procedure qsort(ls,ld:longint);
var i,j:longint;
begin
  i:=ls;j:=ld;
  while true do begin
    while ((v[i].y>v[j].y)or((v[i].y=v[j].y)and(v[i].x>=v[j].x)))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].y>v[j].y)or((v[i].y=v[j].y)and(v[i].x>=v[j].x)))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;
                end;
qsort(1,n);
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.