Cod sursa(job #872006)

Utilizator KangJiYoungTeuca Sergiu KangJiYoung Data 5 februarie 2013 17:43:43
Problema Submultimi Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.3 kb
program TT;
type stiva=array[1..16] of word;
VAR v:stiva;
    f,g:text;
    caut:boolean;
    k,n,c:word;

procedure afisare(v:stiva;k:integer);
VAR i:integer;
Begin
        for i:=1 to k do
                write(g,v[i],' ');
        writeln(g);
End;

function continuare(v:stiva;k:integer):boolean;
VAR ok:boolean;
    i:integer;
Begin
        ok:=true;
        for i:=1 to k-1 do
                if v[i]>=v[k] then begin
                ok:=false;
                break;
        end;
        continuare:=ok;
End;

procedure back(var v:stiva;n:integer);
Begin
k:=1;
v[k]:=0;
c:=1;
while (k>0) do begin
        caut:=false;
        while (caut=false) AND (v[k]<n) do begin
                inc(v[k]);
                if continuare(v,k) then caut:=true;
        end;
        if not caut then dec(k)
                else if k<n then begin
                        afisare(v,k);
                        inc(k);
                        end
                        else begin
                        afisare(v,k);
                        inc(c);
                        k:=c;
                        end;

end;
end;

Begin
        assign(f,'submultimi.in'); Reset(f);
        assign(g,'submultimi.out'); Rewrite(g);
        readln(f,n);
        back(v,n);
        Close(g);
End.