Cod sursa(job #141596)

Utilizator gicurezCostea Marin gicurez Data 23 februarie 2008 14:30:53
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.25 kb
type vec=array[1..821]of word;
	 wec=array[1..30000]of longint;

var v:vec; a:wec;
	rez,n:longint;



procedure readdata;
var f:text;
	i,x,j: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;

v[n+1]:=v[n]+1;
//v[n+2]:=v[n]+2;

close(f);
end;


procedure fa;
var i,j,max:longint;

begin

for i:=1 to n do
	if v[i+1]>v[i] then	for j:=v[i] to v[i+1]-1 do a[j]:=i
    else inc(a[v[i]]);

{max:=30000;
if v[n]+v[n-1]<30000 then max:=v[n]+v[n-1];

for i:=v[n]}

end;

procedure afla;
var i,j,r,e:longint;

begin


for i:=1 to n-1 do
	for j:=i+1 to n do
    	begin
        	if v[i]+v[j]<=30000 then
            	begin
                	if v[i]+v[j]>v[n] then e:=a[v[n]]
                     				  else e:=a[v[i]+v[j]];
	            	r:=e-a[v[j]];
    	            rez:=rez+r;
                end;

        end;

end;


procedure writedata;
var f:text;
begin

assign(f,'nrtri.out'); rewrite(F);
writeln(f,rez);
close(f);
end;

Begin
readdata;
fa;
afla;
writedata;
End.