Cod sursa(job #57737)

Utilizator cezar305Mr. Noname cezar305 Data 2 mai 2007 21:15:33
Problema Trapez Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.44 kb
var f1,f2:text;
    i,j,n,g,au,nrnew:longint;
    aux:extended;
    a:array[1..1000000] of extended;
    x,y:array[1..1000] of longint;
    e,b,z,nr:int64;

procedure pozitie(var m:longint; p,u:longint);
var i,j,di,dj,aux:longint;
begin
di:=0;
dj:=-1;
i:=p;
j:=u;
while i<j do
begin
if a[i]>a[j] then
begin
au:=di;
di:=-dj;
dj:=-au;
a[i]:=a[i]+a[j];
a[j]:=a[i]-a[j];
a[i]:=a[i]-a[j];
end;
i:=i+di;
j:=j+dj;
end;
m:=i;
end;

procedure quick(p,u:longint);
var m:longint;
begin
if p<u then
begin
pozitie(m,p,u);
quick(p,m-1);
quick(m+1,u);
end;
end;

begin
        assign(f1,'trapez.in');
        reset(f1);
        assign(f2,'trapez.out');
        rewrite(f2);
        read(f1,n);
        for i:=1 to n do
                read(f1,x[i],y[i]);
        g:=0;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                begin
                        inc(g);
                        e:=sqr(x[i]-x[j])+sqr(y[i]-y[j]);
                        b:=y[i]-y[j];
                        a[g]:=b/e;
                end;
        quick(1,g);
        for i:=1 to g do
        begin
                if a[i]=a[i-1] then inc(nrnew);
                if a[i]>a[i-1] then
                begin
                        z:=nrnew;
                        nr:=nr+(z*(z+1)) div 2;
                        nrnew:=0;
                end;
        end;
        writeln(f2,nr);
        close(f1);
        close(f2);
end.