Как обычно, прежде всего набросаем схему программы без подробностей. То, что пока трудно выразить на языке Perl, запишем в виде комментариев. Впоследствии переведём эти комментарии на Perl.

Perl
sub permutations
{
	my $n=shift;

	❶ найти и возвратить список всех n-перестановок
}

print "@$_\n" for permutations(shift);	вывести результаты

При каждом проходе переборного цикла … for permutations(shift) очередная перестановка попадает в переменную $_. Она разадресовывается (@$_), и, поскольку полученный массив вставлен в ""-строку ("@$_\n"), происходит его интерполяция: вставка в строку всех его элементов, разделённых пробелами. Именно это нам и нужно.

Альтернативным решением было бы такое, менее лаконичное:

Perl
print(join(' ', @$_), "\n") for permutations(shift);

Процедура join принимает строку-разделитель и массив. Возвращает она строку, составленную из элементов массива, между которыми вставлен разделитель. К примеру, join(', ', 'март', 'апрель', 'май') возвращает строку 'март, апрель, май', а join('', 1..100) возвращает '12345678910111213…9899100' (это длинная строка, целиком она бы не уместилась на экране).

Поскольку процедуре join требуется массив, а мы располагаем лишь ссылкой на массив, следует эту ссылку разыменовать: @$_.

Теперь займёмся телом процедуры permutations (фрагментом ❶):

Perl
sub permutations
{
	my $n=shift;

	❶ обработать особый случай, когда $n=0$ и возвратить список,
	состоящий из единственной нуль-перестановки

	❷ объявить локальный массив @permutations, в котором будут
	постепенно накапливаться $n$-перестановки

	❸ цикл по всем $\left(n-1\right)$-перестановкам
	{
		❹ цикл по всем способам вставить в каждую из них число $n$
		{
			❺ вставить число $n$ текущим способом в текущую
			$\left(n-1\right)$-перестановку и вставить полученную $n$-перестановку
			в массив @permutations
		}
	}

	return @permutations;
}

Фрагменты ❶ и ❷:

Perl
return ([]) unless my $n=shift;
my @permutations;

Для фрагмента ❸ воспользуемся циклом, перебирающим элементы массива — списка перестановок. Этот список возвращается при рекурсивном вызове этой же процедуры permutations, но с параметром $n-1$:

Perl
for(permutations($n-1))

Для того, чтобы организовать цикл по всем способам вставки числа $n$ в $n-1$-перестановку, пронумеруем эти способы от $0$ до $n-1$. Вставка под номером $i$ происходит непосредственно перед тем элементом массива-перестановки, который имеет индекс $i$. Таким образом, при $i=0$ вставка осуществляется в самое начало массива, а при $i=n-1$ — после самого последнего элемента. Заголовок цикла в фрагменте ❹ получается самым банальным:

Perl
for(my $i=0; $i<$n; $i++)

Для вставки в массив элемента используем встроенную процедуру splice, предназначенную именно для этой цели. Первый параметр при её вызове — массив, в котором заменяется диапазон элементов. Второй параметр — индекс начального элемента диапазона. Третий — длина диапазона. Наконец, оставшиеся параметры — элементы, которые вставляются вместо заданного диапазона. В нашем случае индексом начала диапазона будет $i, длина — 0, единственный вставляемый элемент — $n.

Фрагмент ❺ требует особого внимания. Было бы неверным делать вставки прямо в тот анонимный массив, на который указывает ссылка в переменной $_:

Perl
splice @$_, $i, 0, $n;
push @permutations, $_;

В этом случае при каждом проходе внутреннего цикла ❹ происходила бы вставка в один и тот же массив. Правильно будет при каждом проходе этого цикла создавать копию массива, расположенного по ссылке $_, и однократно вставлять на $i-е место в этот массив число $n. Приводим правильный код:

Perl
my @p=@$_;					делаем копию
splice @p, $i, 0, $n;
push @permutations, \@p;	добавляем в список перестановок ссылку на эту копию

Обратите внимание, что массив-копия @p создаётся при каждом проходе цикла, причём это имя объявлено как локальное в цикле. Это значит, что при завершении прохода имя @p уничтожается, однако массив, связанный с этим именем, продолжает жить уже в качестве анонимного. Этот массив исчез бы вместе с его именем, если бы в программе не продолжала своё существование ссылка на него. Эта ссылка помещается в массив @permutations, который объявлен вне обоих циклов и его имя просуществует вплоть до завершения процедуры. Сам же этот массив, вместе с содержащимися в нём ссылками и с тем, на что они ссылаются, просуществует и дальше, поскольку он возвращается из процедуры оператором return и используется дальше в программе. В Perl имеется механизм сборки мусора, который во время выполнения программы следит за объектами в памяти и периодически их уничтожает, освобождая память, если перестала существовать последняя ссылка на этот объект и было уничтожено имя этого объекта (последнее происходит при выходе из блока, в котором объект был объявлен локальным при помощи my).

Итеративная реализация программы, использующая тасование, включает определение процедуры nextShuffle, принимающей в качестве параметра тасование, и возвращающей следующее за ней тасование. Если процедуре nextShuffle передано самое последнее тасование, она возвращает неопределённое значение. Алгоритмы, подобные тому, что реализован в процедуре, называют итераторами. С их помощью последовательно перебираются элементы некоторого списка; в данном случае, элементы списка тасований. Необходимо, чтобы для множества был однозначно определён порядок перебора его элементов, то есть правило, позволяющее для данного элемента определить «следующий» за ним (в некотором смысле). Кроме того, среди элементов множества нужно выделить «самый первый», то есть такой, что цепочка следующих за ним рано или поздно заполнит всё множество, причём каждый элемент множества встретится в цепочке ровно один раз. Единственный элемент множества, «самый последний», не имеет следующего за ним: обычно итератор, получив самый последний элемент, возвращает особое значение, сигнализирующее об окончании перебора. В языке Perl удобно в качестве такого особого значения использовать неопределённое.

В разделе «Тасование» мы решили представлять тасования как последовательности номеров карт в воображаемой колоде, причём нумерация карт начиналась с единицы. Теперь, когда вместо карт будут числа, колоду придётся размещать в массиве. Поэтому в качестве номеров карт в колоде будет удобнее использовать индексы элементов массива, а индексация в Perl, как нам известно, начинается с нуля. Например, вместо последовательности $〈1,1,3,2,3,5〉$ то же самое тасование будем представлять как последовательность $〈0,0,2,1,2,4〉$. Такая подмена почти не отразится на алгоритме, предназначенном для перебора тасований, разве что теперь перебор начнётся с $〈0,0,\dots ,0〉$, а не с $〈1,1,\dots ,1〉$.

Процедура nextShuffle получает очередное тасование как ссылку на массив, и возвращает следующее тасование снова как ссылку на массив. В цикле находится индекс того элемента, который можно увеличить, не нарушив ограничение (элемент строго меньше его индекса). Если это удаётся, найденный элемент увеличивается на единицу, после чего итератор тут же возвращает ту самую ссылку, которую он получил как параметр. Ссылка та же, но один элемент в массиве, на который она указывает, изменился. В противном случае элемент обнуляется, и поиск продолжается. Если ни один элемент увеличить нельзя (а это выяснится к моменту завершения цикла), вместо ссылки возвращается неопределённое значение.

Perl
sub nextShuffle($)
{	my $shuffle=shift;
	for(my $i=1; $i<@$shuffle; $i++)
	{
		if($shuffle->[$i]<$i)
		{
			$shuffle->[$i]++;
			return $shuffle;
		}
		else
		{
			$shuffle->[$i]=0;
		}
	}
	return;
}

Переходим к исполняемой части программы. Отправив переданное в командной строке число в переменную $n, начинаем цикл, перебирающий тасования:

Perl
my $n=shift;
die "$0: Нужно неотрицательное число!\n" unless defined($n) and $n>=0;

for(my $shuffle=[(0) x $n]; defined $shuffle; $shuffle=nextShuffle($shuffle))
{
	my @p=(1..$n);
	@p[$_, $shuffle->[$_]]=@p[$shuffle->[$_], $_] for 0..$n-1;
	print "@p\n";
}

Обратите внимание на выражение [(0) x $n] в заголовке цикла. Так создаётся ссылка на анонимный массив, заполненный $n нулями.

В теле цикла создаётся и тасуется виртуальная колода карт (массив @p). Рассуждая о тасовании в разделе «Тасование», мы последовательно меняли местами очередную карту с некоторой картой, имеющей в колоде меньший или равный номер, и начинали мы с последней карты в колоде. Так что следовало бы вместо цикла … for 0..$n-1 использовать цикл, перебирающий карты от конца к началу колоды, … for reverse 0..$n-1 (встроенная процедура reverse получает список и возвращает другой, отличающийся противоположным порядком элементов). Но уверяем читателя, что это было бы совершенно ненужным добавлением. Впрочем, отметим, что наше упрощение отразится на том порядке, в котором программа выведет перестановки.

Программа готова.

Как и в версии программы, основанной на тасовании, нам понадобится итератор. Но на этот раз при помощи итератора будут перебираться не тасования, а сами перестановки. Назовём процедуру-итератор nextPermutation. Обсуждение определения процедуры (это единственное нетривиальное место в программе) мы отложим на потом, а сейчас рассмотрим исполняемую часть программы:

Perl
my $n=shift;
die "$0: Нужно неотрицательное число!\n" unless defined($n) and $n>=0;

for(my $p=[1..$n]; defined $p; $p=nextPermutation($p))
{
	print "@$p\n";
}

В цикле осуществляется последовательный перебор перестановок начиная с тождественной. Условием продолжения цикла является успешность вызова процедуры nextPermutation, то есть определённость возвращаемого из неё значения.

В теле процедуры nextPermutation первым делом получаем в переменную $p переданный параметр — очередную перестановку (напомним, это ссылка на анонимный числовой массив). Следующий шаг — поиск самого последнего числа в полученной перестановке, меньшего, чем следующее за ним. Естественно, такие числа лучше искать справа налево, начиная с предпоследнего. В цикле будут перебираться индексы (в порядке убывания) в массиве, на который указывает ссылка $p. Индекс самого последнего элемента в таком массиве — $#$p.

Perl
my $p=shift;
my $i=$#$p-1;
$i-- while $i>=0 and $p->[$i]>$p->[$i+1];

Обратите внимание на условие цикла: $i>=0 and $p->[$i]>$p->[$i+1]. Здесь важен порядок операндов логического оператора and. Поскольку может так случиться, что нужный нам индекс так и не будет найден (это происходит как раз в случае, когда $p содержит самую последнюю перестановку), переменная $i рискует получить значение -1. Если именно в этот момент мы попытаемся сравнить $p->[$i] и $p->[$i+1], мы столкнёмся с ошибкой: выражение $p->[-1] означает самый последний элемент массива @$p! Поэтому, вычисляя условие цикла, важно прежде проверить, не вышел ли индекс в массиве за допустимые пределы (не стал ли он отрицательным), и уж затем проверять оставшуюся часть условия.

По окончании цикла while возможны две ситуации: индекс $i неотрицателен (следующая перестановка существует, и она должна быть построена и возвращена из процедуры), и $i равен минус единице (следующей перестановки нет, и следует возвратить неопределённое значение). Поэтому остаток тела процедуры будет выглядеть так:

Perl
if($i>=0)
{
	построить и возвратить следующую за $p перестановку
}
return;

Числа, стоящие правее $i-го, как мы уже упоминали, упорядочены по убыванию. Самое первое из них, с индексом $i+1, заведомо больше $i-го (это одно из обязательных условий, которому должно удовлетворять $i-е число). В результате выполнения кода

Perl
my $j=$i+1;
$j++ while $j<$#$p and $p->[$j+1]>$p->[$i];

будет найден индекс $j числа, расположенного правее $i-го и наименьшего среди чисел больших, чем $i-е. Этот цикл while устроен аналогично циклу, с помощью которого мы ранее искали $i, только в нём перебор осуществляется слева направо. В такой же мере здесь справедливо и замечание о порядке операндов в операторе and.

Теперь меняем местами $i-е и $j-е числа:

Perl
@$p[$i, $j]=@$p[$j, $i];

Заключительный шаг — упорядочение чисел, начиная с $i+1-го, по возрастанию (пока что они упорядочены по убыванию), и возврат изменённой перестановки $p:

Perl
push @$p, reverse splice @$p, $i+1;
return $p;

Выражение splice @$p, $i+1 вырезает из массива @$p список чисел, стоящих правее $i-го, и возвращает этот список. Выражение reverse splice @$p, $i+1 меняет порядок элементов списка на противоположный — теперь числа в списке возрастают. Наконец, вся команда в сборе push @$p, reverse splice @$p, $i+1 возвращает на место удалённый «хвост» массива @$p, но уже переупорядоченный.

Всё готово:

Perl
sub nextPermutation($)
{
	my $p=shift;
	my $i=$#$p-1;
	$i-- while $i>=0 and $p->[$i]>$p->[$i+1];
	if($i>=0)
	{
		my $j=$i+1;
		$j++ while $j<$#$p and $p->[$j+1]>$p->[$i];
		@$p[$i, $j]=@$p[$j, $i];
		push @$p, reverse splice @$p, $i+1;
		return $p;
	}
	return;
}

Итератор, способный перебирать перестановки в порядке лексикографического возрастания, решает задачу сортировки списка чисел в порядке убывания — ведь перестановки реализованы в нашей программе именно как списки чисел от $1$ до $n$. Переходя от одной перестановки к другой, следующей, мы постепенно «наводим порядок», стремясь в конце концов к перестановке, числа в которой строго убывают. На каждом шаге для построения следующей перестановки требуется совершить несколько парных обменов (транспозиций), в том числе и транспозиций, неявно выполняемых встроенной процедурой reverse. Процедура nextPermutation без каких-либо изменений может быть использована для упорядочения по невозрастанию произвольных числовых списков (не обязательно состоящих из чисел от $1$ до $n$).

Заменив в двух местах оператор арифметического «больше» > на оператор строкового «больше» gt, мы получим процедуру, пригодную и для сортировки списков строк в порядке, противоположном алфавитному.

Небольшое изменение в алгоритме позволит нам сортировать числовые или строковые списки в порядке неубывания — нужно запрограммировать итератор множества перестановок, перебирающий их в порядке, противоположном лексикографическому.

Иными словами, наша программа являет собой готовое решение задачи сортировки списков. Насколько удачно такое решение? Оно в наихудшем случае (когда в начале список полностью упорядочен по неубыванию, а в конце — по невозрастанию) потребует перебора всех перестановок этого списка, которых $n!$ штук. В среднем для списка, взятого наугад, потребуется перебрать в два раза меньше вариантов, что тоже очень много. Если отказаться от намерения перебирать перестановки из $S_n$ подряд, строго следуя их лексикографическому порядку, можно получить гораздо более эффективные алгоритмы сортировки.

Обсуждение разных подходов к сортировке списков содержится в главе 18. «Сортировка».