Cod sursa(job #1013157)

Utilizator PetreFlorinaFMI Petre Florina PetreFlorina Data 20 octombrie 2013 14:13:32
Problema Generare de permutari Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.09 kb
type vect=array [1..100] of integer;
var n,k,i : integer; ev,as:boolean; st:vect;  f,g:text;
 procedure succesor(k:integer; var st:vect ; var as:boolean);
 begin
  if st[k]<n then
   begin
    inc(st[k]);as:=true;
    end
    else as:=false;
 end;
 procedure valid (k:integer ; st:vect; var ev:boolean);
 begin
  ev:=true;
  for i:= 1 to k-1 do
   if st[i]=st[k] then ev:=false;
   end;
  procedure  tipar(k:integer);
  var i:integer;
  begin
   for i:= 1 to k do
    write(g,st[i],' ');
    writeln(g);
    end;
  function solutie (k:integer):boolean;
  begin
   if k=n then solutie:=true
   else solutie:=false;
   end;
  procedure back;
  begin
   k:=1;
   st[k]:=0;
   while k>0 do
   begin
   repeat
    succesor(k,st,as);
    if as then valid(k,st,ev);
   until (as and ev) or (not as);
    if as then
     if solutie(k) then tipar(k)
     else begin
     inc(k);
     st[k]:=0;
     end
     else k:=k-1;end;end;
   begin
   assign(f,'permurati.in');reset(f);
   assign(g,'permurati.out');rewrite(g);
   read(f,n);
   close(g);close(f);
   back;
   end.