Cod sursa(job #1142386)

Utilizator ROMaANUMitea Lucian ROMaANU Data 13 martie 2014 19:49:18
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.16 kb
uses crt;
type stiva=array[1..8]of integer;
var st:stiva;n,k:integer;
    as,ev:boolean;
    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;
     inc(st[k]);
     end else as:=false;
 end;
procedure validare(k:integer;st:stiva;var ev:boolean);
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 k do write(g,st[i],' ');
 writeln(g);
 end;
begin
clrscr;
assign(f,'permutari.in');
reset(f);
read(f,n);
close(f);
assign(g,'permutari.out');
rewrite(g);
k:=1;
init(k,st);
while k>0 do
   begin
   repeat
    succesor(k,st,as);
    if as then
       validare(k,st,ev);
   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 k:=k-1;
   end;
   close(g);
end.