Cod sursa(job #335593)

Utilizator sapiensCernov Vladimir sapiens Data 30 iulie 2009 16:25:32
Problema Generare de permutari Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 0.89 kb
Program permutari;
 var f,g:text; a:array[0..9]of 0..8;
     n:byte;
 procedure initiere;
  begin
   assign (f,'permutari.in'); reset (f);
   assign (g,'permutari.out'); rewrite (g);
   readln (f,n);
  end;
 procedure incheiere;
  begin
   close (f); close (g);
  end;
 procedure swap (x,y:byte);
  var z:byte;
  begin
   z:=a[x];
   a[x]:=a[y];
   a[y]:=z;
  end;
 function fact (x:byte):word;
  begin
   if x=1 then fact:=1 else fact:=x*fact (x-1);
  end;
 procedure generare;
  var x:word; y,z:byte;
  begin
   for x:=0 to n do a[x]:=x;
   a[n+1]:=0;
   for x:=1 to fact (n) do begin
     for y:=1 to n do write (g,a[y],' '); writeln (g);
     y:=n;
     while a[y]<a[y-1] do y:=y-1;
     z:=y;
     while a[z]>a[y-1] do z:=z+1;
     swap (y-1,z-1);
     for z:=y to (y+n-1) div 2 do swap (z,n+y-z);
   end;
  end;
 begin
  initiere;
  generare;
  incheiere;
 end.