Cod sursa(job #967958)

Utilizator wollyFusy Wool wolly Data 28 iunie 2013 21:51:02
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.89 kb
type tabel=array[1..1000] of longint;
var i,n,tot:longint;
	u,t:tabel;
	a,b:text;


function correct(i,j,k:longint):boolean;
begin
correct:=false;
{if (u[i]>u[j]) and (u[i]>u[k]) then if u[j]+u[k]>=u[i] then correct:=true;
if (u[j]>u[i]) and (u[j]>u[k]) then if u[i]+u[k]>=u[j] then correct:=true;}
if (u[k]>u[j]) and (u[k]>u[i]) then if u[j]+u[i]>=u[k] then correct:=true; 
end;

procedure f(k,l:longint);
var i,j,v:longint;
begin
if k<l+1 then
	for i:=1 to n do
	begin
		t[k]:=i;
		f(k+1,l);
	end;
v:=0;
if k=l+1 then
begin
	for i:=1 to l do
		for j:=1 to l do
		if j<>i then 
			if t[i]=t[j] then
			v:=1;
if t[1]>t[2] then v:=1;
	if v=0 then 
		if correct(t[1],t[2],t[3]) then
		begin
			tot:=tot+1;
			{writeln(t[1],t[2],t[3]);}
		end;
	end;
end;

begin
assign(a,'ntri.in');
reset(a);
assign(b,'ntri.out');
rewrite(b);
read(a,n);
for i:=1 to n do
	read(a,u[i]);
f(1,3);
writeln(b,tot);
close(a);
close(b);
end.