Hапечатать все перестановки чисел 1..N

Материал из DRKB


First = (1, 2, ..., N)
Last = (N, N-1, ..., 1)

Всего таких перестановок будет N! = N * (N-1) * ... * 2 * 1 (докажите!). Для составления алгоритма Next зададимся вопросом: в каком случае i-ый член перестановки можно увеличить, не меняя предыдущих? Ответ: если он меньше какого-либо из следующих членов (членов с номерами больше i).

Мы должны найти наибольшее i, при котором это так, т.е. такое i, что X[i] < X[i+1] > ... > X[N] (если такого i нет, то перестановка последняя). После этого X[i] нужно увеличить минимально возможным способом, т.е. найти среди X[i+1], ..., X[N] наименьшее число, большее его. Поменяв X[i] с ним, остается расположить числа с номерами i+1, ..., N так, чтобы перестановка была наименьшей, то есть в возрастающем порядке. Это облегчается тем, что они уже расположены в убывающем порядке:

procedure Next;
begin
  { найти i: X[i] < X[i+1] > X[i+2] > ... > X[N]};
  { найти j: X[j] > X[i] > X[j+1] > ... > X[N]};
  { обменять X[i] и X[j]};
  { X[i+1] > X[i+2] > ... > X[N]};
  { перевернуть X[i+1], X[i+2], ..., X[N]};
end;


Теперь можно написать программу:

program Perestanovki;
type
  TPere = array [Byte] of Byte;

var
  N, i, j: Byte;
  X: TPere;
  Yes: Boolean;

procedure Next(var X: TPere; var Yes: Boolean);
var
  i: Byte;

  procedure Swap(var a, b: Byte);  { обмен переменных }
  var
    c: Byte;
  begin
    c := a;
    a := b;
    b := c;
  end;

begin
  i := N-1;
  { поиск i }
  while (i > 0) and (X[i] > X[i+1]) do Dec(i);
  if i > 0 then
  begin
    j := i+1;
    { поиск j }
    while (j < N) and (X[j+1] > X[i]) do Inc(j);
    Swap(X[i], X[j]);
    for j := i+1 to (N+i) div 2 do
      Swap(X[j], X[N-j+i+1]);
    Yes := True
  end
  else
    Yes := False
end;


begin
  Write('N=');
  ReadLn(N);
  for i := 1 to N do
    X[i] := i;
  repeat
    for i := 1 to N do
      Write(X[i]);
    WriteLn;
    Next(X, Yes);
  until not Yes;
end.


Решение через рекурсию[править | править код]

Опишем рекурсивную процедуру Generate(k), предъявляющую все перестановки чисел 1, ..., N, у которых фиксировано начало X[1], X[2], ..., X[k]. После выхода из процедуры массив X будут иметь то же значение, что перед входом (это существенно!). Понятно, что при k=N мы снова имеем только тривиальное решение - саму перестановку. При k < N будем сводить задачу к k+1:

procedure Generate(k: Byte);
var
  i, j: Byte;

  procedure Swap(var a, b: Byte);
  var c: Byte;
  begin
    c := a;
    a := b;
    b := c;
  end;

begin
  if k = N then
  begin
    for i := 1 to N do
      Write(X[i]);
    WriteLn;
  end
  else
    for j := k+1 to N do
    begin
      Swap(X[k+1], X[j]);
      Generate(k+1);
      Swap(X[k+1], X[j]);
    end;
end;


Основная программа[править | править код]

program PerestanovkiRecursion;
type
  TPere = array [Byte] of Byte;
var
  N, i, j: Byte;
  X: TPere;
  
procedure Generate(k: Byte);
{...............}
begin
  Write('N=');
  ReadLn(N);
  for i := 1 to N do
    X[i] := i;
  Generate(0);
end.


Чтобы до конца разобраться в этой непростой программе, советуем выполнить ее на бумаге при N=3. Обратите внимание, что порядок вывода перестановок не будет лексикографическим!


Source: http://algolist.manual.ru
ID: 04184