Cod sursa(job #411245)

Utilizator ivanhoeNociv Hasis ivanhoe Data 4 martie 2010 19:44:56
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.85 kb
var
 x:array[1..8] of byte;
 n,k,i:byte;
 ok:boolean;
 f,g:text;
procedure cont(k:integer; var ok:boolean);
var
 i:integer;
begin
 ok:=true;
 for I:=1 to k-1 do
  if x[i]=x[k]
   then
    ok:=false;
end;
function succesor(k:byte):boolean;
begin
 succesor:=false;
 if x[k]<n
  then
   begin
    x[k]:=x[k]+1;
    succesor:=true;
   end;
end;
begin
 assign(f,'permutari.in');
 reset(f);
 readln(f,n);
 close(f);
 assign(g,'permutari.out');
 rewrite(g);
 k:=1;
 x[k]:=0;
 while (k>0) do
  begin
   ok:=false;
   while (not ok) and succesor(k) do
    cont(k,ok);
   if not ok
    then
     k:=k-1
    else
     if k=n
      then
       begin
        for I:=1 to n do
         write(g,x[i],' ');
        writeln(g);
       end
      else
       begin
        k:=k+1;
        x[k]:=0;
       end;
  end;
 close(g);
end.