Cod sursa(job #166247)

Utilizator kolapsysPostelnicu Dan Marian kolapsys Data 27 martie 2008 18:53:54
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.48 kb
type stiva=array[1..20] of integer;
var as,ev:boolean;
    st:stiva;
    k,n:integer;
    f,g:text;
procedure init(k:integer; var st:stiva);
begin
        st[k]:=0;
end;
procedure succesor(k:integer; var st:stiva; var as:boolean);
begin
        if st[k]<n then begin
                        as:=true;
                        st[k]:=st[k]+1;
                        end
                   else as:=false;
end;
procedure valid(k:integer; st:stiva; var ev:boolean);
var i:integer;
begin
        ev:=true;
        for i:=1 to k-1 do
            if st[i]=st[k] then ev:=false;
end;
function sol(k:integer):boolean;
begin
        sol:=(k=n);
end;
procedure tipar;
var i:integer;
begin
        for i:=1 to n do
                write(g,st[i],' ');
        writeln(g);
end;
BEGIN
        assign(f,'permutari.in'); reset(f);
        assign(g,'permutari.out'); rewrite(g);
        read(f,n);
        k:=1;
        init(k,st);
        while k>0 do
                begin
                repeat
                        succesor(k,st,as);
                        if as then valid(k,st,ev);
                until not(as) or (as and ev);
                if as then if sol(k) then tipar
                                     else begin
                                          k:=k+1;
                                          init(k,st);
                                          end
                      else k:=k-1;
                end;
        close(f); close(g);
END.