Cod sursa(job #1118367)

Utilizator TheStifmeisterRusu Alex TheStifmeister Data 24 februarie 2014 10:32:04
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.27 kb
program permutari;
var st:array[1..25] of integer;
i,n,p:integer;
f,g:text;
procedure init;
 begin
  readln(f,n);
  for i:=1 to n do
   st[i]:=0;
 end;
 function valid(p:integer):boolean;
  begin
  valid:=true;
  for i:=1 to p-1 do
   if st[i]=st[p] then valid:=false;
 end;
  procedure tipar(p:integer);
  var i:integer;
  begin
   for i:=1 to p do
     write(g,st[i],' ');
    writeln(g);
  end;
  procedure back(p:integer);
   begin p:=1;
   {plecam de la primul nivel }
    st[p]:=0;
   {initializam nivelul cu 0}
    while p>0 do
   {cat timp stiva nu este vida}
     begin
      if st[p]<n then
    {mai exista valori neincercate pe nivelul p}
       begin
       st[p]:=st[p]+1;
     {st[p]<-<o noua valoare din multimea valorilor posibile>}
      if valid(p) then
       if p=n then tipar(p)
      {solutia este finala}
              else begin p:=p+1;
       {trecem la nivelul urmator}
                   st[p]:=0;
       {initializam valoarea de pe nivel cu 0}
       end;
       end
       else
       p:=p-1; {pas inapoi}
        end;
        end;
        begin
        assign(f,'permutari.in');reset(f);
        assign(g,'permutari.out');rewrite(g);
        init;
        back(1);
        close(f);
        close(g);
        end.