Cod sursa(job #275011)

Utilizator andrei1991Popescu Andrei andrei1991 Data 10 martie 2009 10:11:47
Problema Generare de permutari Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.04 kb
program permutari;
type stiva=array [1..100] of integer;
var st:stiva;
    n,k:integer;
    as,ev:boolean;

procedure init(k:integer;var st:stiva);
begin
st[k]:=0;
end;

procedure succesor (var as:boolean;var st:stiva;k:integer);
begin
if st[k]<n then
   begin
     st[k]:=st[k]+1;
     as:=true;
   end
   else as:=false;
end;

procedure valid(var ev:boolean;st:stiva;k:integer);
var i:integer;
begin
ev:=true;
for i:=1 to k-1 do
   if st[k]=st[i] then ev:=false;
end;

function solutie (k:integer):boolean;
begin
solutie:=(k=n);
end;

procedure tipar;
var i:integer;
begin
for i:=1 to n do write(g,st[i]:3);writeln(g);
end;

BEGIN
assign(f,'permutari.in');reset(f);
assign(g,'permutari.out');rewrite(g);
end;
readln(f,n);
k:=1;
init(k,st);
while (k>0) do
  begin
    repeat
       succesor(as,st,k);
       if as then valid(ev,st,k);
    until (not as) or (as and ev);
  if as then if solutie(k) then tipar
  else
     begin
       k:=k+1;
       init(k,st)
     end
       else dec(k);
     end;
  
end.