# Cod sursa(job #17592)

Utilizator Data 16 februarie 2007 12:04:59 Numarare triunghiuri 15 fpc done Arhiva de probleme 1.58 kb
``````var st:Array[1..3]of longint;
v:array[1..1000]of longint;
n,k,i,j:longint;
as,ev:boolean;
f:text;
procedure citire;
var f:text;
begin
assign(f,'nrtri.in');reset(f);
for i:=1 to n do read(f,v[i]);
end;
procedure sort(s,d:integer);
var aux,i,j,e:integer;
begin
i:=s;
j:=d;
e:=v[(s+d)div 2];
repeat
while v[i]<e do inc(i);
while v[j]>e do dec(j);
if i<=j then begin
aux:=v[i];
v[i]:=v[j];
v[j]:=aux;
inc(i);
dec(j);
end;

until i>j;
if s<j then sort(s,j);
if d>i then sort(i,d);
end;
procedure init;
begin
st[k]:=0;
end;
procedure succesor;
begin
if st[k]<n then begin
as:=true;
inc(st[k]);
end
else as:=false;
end;
procedure valid;
begin
ev:=true;
i:=1;
while (i<=k-1)and ev do begin if st[k]=st[i] then ev:=false; inc(i); end;
if ev then if k>=2 then if st[k-1]>st[k] then ev:=false;
if ev then if k=3 then if v[st[1]]+v[st[2]]<v[st[3]] then ev:=false;
end;
function solutie:boolean;
begin
solutie:=(k=3);
end;
begin {pp}
citire;
writeln('solutii right');
sort(1,n);
k:=1;
init;
while k>0 do
begin
repeat succesor;
if as then valid;
until not as or (as and ev);
if as then if solutie then
begin
inc(j);
writeln(st[1],' ',st[2],' ',st[3]);
end
else begin inc(k); init; end
else dec(k);
end;
assign(f,'nrtri.out');
rewrite(f);
write(f,j);
close(f);
end.
``````