Cod sursa(job #73525)

Utilizator vanila0406Ionescu Victor vanila0406 Data 19 iulie 2007 11:07:38
Problema Trapez Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.59 kb
program trapez;
type punct=record
        x,y:longint;
end;
panta=record
        a,b:longint;
end;
var f,g:text;
        n,ln,dim:longint;
        v:array[1..1000001] of panta;
        b:array[1..1001] of punct;


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,b[i].x,b[i].y);
        close(f);
end;



procedure form_v;
var i,j:longint;
begin
        ln:=0;
        for i:=1 to n-1 do
                for j:=i+1 to n do
                        begin
                                inc(ln);
                                v[ln].a:=b[i].y-b[j].y;
                                v[ln].b:=b[i].x-b[j].x;
                        end;
        dim:=ln;
end;


procedure repair(i:longint);
var l,r,max:longint;
        aux:panta;
begin
        l:=i*2;
        r:=l+1;
        max:=i;
        if (l<=dim)and(v[l].a*v[i].b>v[l].b*v[i].a) then
                max:=l;
        if (r<=dim)and(v[r].a*v[max].b>v[r].b*v[max].a) then
                max:=r;
        if max<>i then
                begin
                        aux:=v[i];
                        v[i]:=v[max];
                        v[max]:=aux;
                        repair(max);
                end;
end;


procedure build_heap;
var i:longint;
begin
        for i:=ln div 2 downto 1 do
                repair(i);
end;


procedure heapsort;
var i:longint;
        aux:panta;
begin
        build_heap;
        for i:=ln downto 2 do
                begin
                        aux:=v[1];
                        v[1]:=v[i];
                        v[i]:=aux;
                        dec(dim);
                        repair(1);
                end;
end;




procedure num;
var i:longint;
        nr,fin,j,k:longint;
begin
        i:=1;
        nr:=0;
        while i<=ln do
                begin
                        fin:=i;
                        j:=i+1;
                        while (j<=ln)and(v[i].a*v[j].b=v[i].b*v[j].a) do
                                begin
                                        inc(fin);
                                        inc(j);
                                end;
                        for j:=i to fin-1 do
                                for k:=j+1 to fin do
                                        inc(nr);
                        i:=fin+1;
                end;
        writeln(g,nr);
        close(g);
end;


begin
        iofile;
        form_v;
        heapsort;
        num;
end.