Cod sursa(job #11761)

Utilizator vanila0406Ionescu Victor vanila0406 Data 1 februarie 2007 16:47:19
Problema Trapez Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.46 kb
program trapeze;
type punct=record
        x,y:longint;
end;
        panta=record
        x,y:int64;
end;
var f,g:text;
        n,lv:longint;
        pn:array[1..1000001] of panta;
        v:array[1..1001] of punct;
        b:array[1..1000001] of qword;



procedure iofile;
var i:longint;
begin
        assign(f,'trapez.in');
        reset(f);
        assign(g,'trapez.out');
        rewrite(g);
        readln(f,n);
        for i:=1 to n do
                readln(f,v[i].x,v[i].y);
        close(f);
end;

procedure pozitie(var m:qword;p,u:qword);
var i,j,di,dj,aux:int64;
        aux1:panta;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
                begin
                        if pn[i].x*pn[j].y>pn[i].y*pn[j].x then
                                begin
                                        aux:=di;
                                        di:=-dj;
                                        dj:=-aux;
                                        aux1:=pn[i];
                                        pn[i]:=pn[j];
                                        pn[j]:=aux1;
                                end;
                        i:=i+di;
                        j:=j+dj;
                end;
        m:=i;
end;



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






procedure pantat;
var i,j:longint;
begin
        lv:=0;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                        begin
                                inc(lv);
                                pn[lv].x:=(v[i].y-v[j].y);
                                pn[lv].y:=(v[i].x-v[j].x);
                        end;
        quick(1,lv);
end;



procedure prel;
var i,nr:longint;
begin
        nr:=0;
        b[1]:=1;
        for i:=2 to lv do
                if (pn[i].x*pn[i-1].y)=(pn[i].y*pn[i-1].x) then
                        begin
                                b[i]:=b[i-1]+1;
                                b[i-1]:=0;
                        end else b[i]:=1;
        for i:=1 to lv do
                if b[i]<>0 then
                        nr:=nr+((b[i])*(b[i]-1))div 2;
        writeln(g,nr);
        close(g);
end;



begin
        iofile;
        pantat;
        prel;
end.