Cod sursa(job #141651)

Utilizator gicurezCostea Marin gicurez Data 23 februarie 2008 15:22:44
Problema Numarare triunghiuri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.54 kb
type aec=array[1..800]of longint;
var  v:aec;
     n,r,i,j:longint;	

procedure readdata;
var f:text;
	i,j,x:longint;
begin

assign(f,'nrtri.in'); reset(f);
readln(f,n);

read(f,v[1]);
for i:=2 to n do
		
        begin
        	read(f,x);
            j:=i;
            while (x<v[j-1]) do begin
            	v[j]:=v[j-1];
                dec(j);
            end;
            v[j]:=x;
        end;

close(f);

end;


function find:longint;
var p,u,m:longint;

begin

	p:=1; u:=n;
    m:=(p+u)div 2;	
	while (p<=u) do
    	begin

           if ( ( (v[m]<=v[i]+v[j]) and (v[m+1]>v[i]+v[j]) )  or ( (v[m]<=v[i]+v[j]) and (m=n) ))
                then begin find:=m; exit; end
                else
                	begin

                      if ( v[m] <= v[i]+v[j]) and (v[m+1]<=v[i]+v[j])
                      	then
  							begin
                            	p:=m+1;
                                m:=(p+u)div 2;
                            end
                        else
                        	begin
                            	u:=m-1;
                                m:=(p+u)div 2;
                            end;

                	end;

           end;

    find:=0;

end;


procedure solve;
var e,s:longint;
begin

for i:=1 to n-2 do
	for j:=i+1 to n-1 do
    	 begin
            e:=find;
         	r:=r+e-j;
         end;

end;


procedure writedata;
var f:text;
begin

assign(f,'nrtri.out'); rewrite(f);
writeln(f,r);
close(f);

end;

Begin
readdata;
solve;
writedata;
End.