Cod sursa(job #138760)

Utilizator gicurezCostea Marin gicurez Data 19 februarie 2008 04:36:20
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.74 kb
type vec=array[1..320400,1..3]of word;
	 aec=array[1..800]of word;
var  v:aec;
	 w:vec;
     n,r,e,b:longint;	

procedure readdata;
var f:text;
	i,x,j:longint;
begin
assign(f,'nrtri.in'); reset(f);
readln(f,n);

//for i:=1 to n do read(f,a[i]);

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(x:longint):longint;
var ps,pd,m:longint;
	ok:boolean;
begin

	ps:=b+1; pd:=n;	
	ok:=false;
	while (ps<=pd)and(not ok) do
    	begin

         m:=(ps+pd)div 2;
         if (x>v[m]) then ps:=m+1
         else
           if (x<v[m]) then pd:=m-1
           else
            begin
            find:=m;
            exit;
           end;

        end;

    if v[m]<x then find:=m
              else find:=m-1;

end;

    	

procedure solve;
var a,c,k,s,sr:longint;
begin

for a:=1 to n-2 do
	for b:=a+1 to n-1 do
    	// begin

         //  s:=v[a]+v[b];
           for c:=b+1 to n do
           		if (v[a]+v[b]>=v[c]) then
                	begin
           			if (v[a]<=v[b]+v[c])and
              		   (v[b]<=v[c]+v[a])and
             		   (v[c]<=v[a]+v[b])
              				then r:=r+1;
                    end
                else break;

          { c:=find(s);
           if (c>b)and
           	  (v[a]<=v[b]+v[c])and
              (v[b]<=v[c]+v[a])and
              (v[c]<=v[a]+v[b])
              		then r:=r+c-b;
		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.