Cod sursa(job #138758)

Utilizator gicurezCostea Marin gicurez Data 19 februarie 2008 03:53:45
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.14 kb
type vec=array[1..320400,1..3]of word;
	 aec=array[1..800]of word;
var  v:aec;
	 av:vec;
     n,r,e: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:=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,b,c,k,s,sr:longint;
begin

for a:=1 to n do
	for b:=a+1 to n do
    	 begin

           s:=v[a]+v[b];
           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;
           {
		   inc(e);
           v[e,1]:=i; v[e,2]:=j;
           v[e,3]:=a[i]+a[j];

           k:=find(a[i]+a[j]);
           r:=r+k;
           if (i<k) then dec(r);
           if (j<k) then dec(r);
         }
         end;

   { for i:=1 to e do
    	begin
        	k:=find(a[i]);
            if (i<>v[
    	for j:=v[i,2]+1 to n do
            if (v[i,3]>=a[j])and(j<>v[i,1])and(j<>v[i,2])
            	then inc(r);


                inc(e); v[e,1]:=a[i]+a[j];
                v[e,1]:=i; v[e,2]:=j;
                }
{for i:=1 to e do
	for j:=n downto 1 do
    		if (a[j]>a[v[i,1]]+a[v[i,2]])and( (j<>v[i,2])or(j<>v[i,1]) )
            then inc(r)
            else break;

r:=r div 2;
}

end;

procedure writedata;
var f:text;
begin
assign(f,'nrtri.out'); rewrite(f);
writeln(f,r);
close(f);
end;

Begin
readdata;
solve;
writedata;
End.