Cod sursa(job #57756)

Utilizator cezar305Mr. Noname cezar305 Data 2 mai 2007 21:58:49
Problema Trapez Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.83 kb
var f1,f2:text;
    i,j,n,g,au,nrnew:longint;
    a:array[1..1000000] of double;
    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:=2 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;
        z:=nrnew;
        nr:=nr+(z*(z+1)) div 2;
        writeln(f2,nr);
        close(f1);
        close(f2);
end.