Cod sursa(job #7755)

Utilizator vanila0406Ionescu Victor vanila0406 Data 22 ianuarie 2007 15:17:00
Problema Numarare triunghiuri Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.97 kb
program nrtri;
var f,g:text;
        v:array[1..801] of longint;
        n,i,j,nr,x:longint;


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



procedure pozitie(var m:longint;p,u:longint);
var di,dj,i,j,aux:longint;
begin
        i:=p;
        j:=u;
        di:=0;
        dj:=-1;
        while i<j do
                begin
                        if v[i]>v[j] then
                                begin
                                        aux:=di;
                                        di:=-dj;
                                        dj:=-aux;
                                        aux:=v[i];
                                        v[i]:=v[j];
                                        v[j]:=aux;
                                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;


function cbin(x,y,s:longint):longint;
var m:longint;
begin
        for m:=x to y do
                if v[m]>s then
                        begin
                                cbin:=m;
                                exit;
                        end;
        cbin:=y+1;
end;



begin
        iofile;
        quick(1,n);
        nr:=0;
        for i:=1 to n-2 do
                for j:=i+1 to n-1 do
                        begin
                                x:=cbin(j+1,n,v[i]+v[j]);
                                if x<>0 then
                        nr:=nr+x-j-1;
                        end;
        writeln(g,nr);
        close(g);
end.