Cod sursa(job #2429121)

Utilizator Arteni_CristiArteni Cristi Arteni_Cristi Data 7 iunie 2019 22:54:54
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.93 kb
var t:array[1..10] of integer;
    n,k,i,c,p:integer;

 procedure tipar;
  begin
   for i:=1 to n do write(t[i],' ');
   writeln
  end;

 function valid (k:integer):boolean;
  begin
   c:=0;
   for i:=1 to k-1 do
    begin
     if t[k]=t[i] then inc(c);
     if c>0 then break
    end;
   if c>0 then valid:=false else valid:=true
  end;

 procedure succ;
  begin
   if t[k]<n then
    begin
     inc(t[k]);
     p:=1
    end
   else p:=0
  end;

 procedure back;
  begin
   k:=1;
   t[k]:=0;
   while k>0 do
    begin
     repeat
      succ;
      if p>0 then valid(k);
     until ((p>0) and (c=0)) or (p=0);
     if p>0 then
      if k=n then tipar else
       begin
        inc(k);
        t[k]:=0
       end
      else dec(k)
    end
  end;

begin
assign(input,'permutari.in'); reset(input);
assign(output,'permutari.out'); rewrite(output);
read(n);
back;
close(input);
close(output)
end.