Cod sursa(job #1013390)

Utilizator PetreFlorinaFMI Petre Florina PetreFlorina Data 20 octombrie 2013 20:40:32
Problema Generare de permutari Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 0.81 kb

type vect= array[1..100] of integer;
var   n:integer; v:vect;
  function valid(k:integer):boolean;
    var j:integer;
     begin
     valid:=true;
      for j:=1 to k-1 do
      if v[j]=v[k] then valid:=false
         end;
  function succ(var v:vect; k:integer):boolean;
   begin
    if v[k]<n then
     begin
      v[k]:=v[k]+1;
      succ:=true;
      end
      else succ:=false;
      end;
   procedure afis;
       var x:integer;
       begin
       for x:= 1 to n do
        write(v[x],' ');
        writeln;
        end;

   procedure back(k:integer);
    var i:integer;
     begin
     if (valid(k) and (k=n+1)) then afis
      else
     begin
      v[k]:=0;
      while succ(v,k) do

       if  valid(k) then back(k+1);
       end;
      end;
   begin
   reaD(n);
   back(1);
   end.