Cod sursa(job #1424379)

Utilizator Stefan.Andras Stefan Stefan. Data 24 aprilie 2015 10:12:17
Problema Submultimi Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.97 kb
var f,g:text;
    n,p:integer;
    x:array[1..18] of byte;
procedure afisare(k:integer);
var i:integer;
begin
  for i:=1 to k do
     write(g,x[i],' ');
  writeln(g);
end;
function cont(k:integer):boolean;
var i:integer;
begin
   cont:=true;
   if (k > 1) and (x[k-1] >= x[k]) then
      cont:=false;
end;
procedure bkt;
var k:integer;
begin
   k:=1;
   x[k]:=0;
   while k>0 do
      if x[k]<n then// daca mai exista valori netestate
        begin
          x[k]:=x[k]+1;// dau urmatoarea valoare posibila
       ///   if cont(k) then
          //      begin
                  afisare(k);
                  if k < n then
                     begin
                     k:=k+1;
                     x[k]:=x[k-1]
                     end;
               // end;
        end
        else
        k:=k-1;
end;
begin
   assign(f,'submultimi.in'); reset(f);
   assign(g,'submultimi.out'); rewrite(g);
   read(f,n);
   bkt;
   close(f); close(g);
end.