Cod sursa(job #17594)

Utilizator hitmannCiocas Radu hitmann Data 16 februarie 2007 12:19:35
Problema Numarare triunghiuri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.82 kb
var st:Array[1..3]of longint;
    v:array[1..800]of longint;
    ap:array[1..maxint]of longint;
    n,k,i,j:longint;
    as,ev:boolean;
    f:text;
procedure citire;
var f:text;
begin
assign(f,'nrtri.in');reset(f);
read(f,n);
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
ev:=true;
if st[k]<n then begin
              if st[k]<>0 then dec(ap[st[k]]);
              as:=true;
              inc(st[k]);
              if ap[st[k]]<>0 then ev:=false;
              inc(ap[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');
k:=1;
init;
while k>0 do
 begin
 repeat succesor;
 if as and ev then valid;
 until not as or (as and ev);
 if as then if solutie then
                       begin
                       inc(j);
                       writeln(v[st[1]],' ',v[st[2]],' ',v[st[3]]);
                       end
                       else begin inc(k); init; end
       else
        begin
        dec(ap[st[k]]);
        dec(k);
        end;
 end;
assign(f,'nrtri.out');
rewrite(f);
write(f,j);
close(f);
end.