Глава 18. Сортировка :: Разработка

Разработка
	Глава 18. Сортировка

Разработка

Во всех случаях реализуем сортировку массива как процедуру, получающую массив как параметр и возвращающую отсортированный массив.

Каждая из программ будет завершаться кодом, выводящим элементы отсортированного списка по одному в строке:

Perl
print "$_\n" for отсортированный список;

Здесь используется цикл для перебора элементов массива, однако не указано, в какую переменную по очереди отправляются элементы массива. В этом случае используется специальная переменная $_.

Глупая сортировка

Запрограммируем процедуру stupidSort, ответственную за глупую сортировку. Она получает список чисел как параметр и возвращает его же, но в отсортированном виде. В процедуре предусмотрим два цикла. Внутренний нужен для поиска очередной инверсии и её устранения, а внешний повторяет эту операцию.

Мы видим, что условие выполнения внешнего цикла вычисляется по итогам работы внутреннего. Поэтому определим логическую флаговую переменную $flag и присвоим ей истинное значение перед входом во внешний цикл, сделав её условием цикла:

Perl
sub stupidSort
{
	my $flag=1;
	while($flag)
	{
		…
	}
	return @_;
}

Пока ещё не написанный код внутри цикла должен найти и уничтожить инверсию, присвоив флаговой переменной истинное значение, или, при отсутствии инверсии, присвоить ложное:

Perl
		for(my $i=0; $i<@_-1; $i++)
		{
			if($_[$i]>$_[$i+1])
			{
				@_[$i, $i+1]=@_[$i+1, $i];
				last;
			}
		}
		$flag=0;

Пузырьковая сортировка

Простая версия

Вся работа в программе выполняется в процедуре bubbleSort. Определяем переменную $right как индекс того элемента списка, которым завершается ещё не обработанная часть списка. В начале работы в переменной хранится последний индекс $#_ массива @_, в знак того, что массив ещё не обработан. После такой подготовки начинаются проходы цикла обработки. Условием цикла будет положительность переменной $right, а в конце каждого прохода $right уменьшается на единицу. Задача внутреннего цикла — устранение встретившихся на данном проходе инверсий. Завершает процедуру возврат отсортированного массива @_:

Perl
sub bubbleSort
{
	my $right=$#_;
	while($right)
	{
		for(my $i=0; $i<$right; $i++)
		{
			@_[$i, $i+1]=@_[$i+1, $i] if $_[$i]>$_[$i+1];
		}
		$right--;
	}
	return @_;
}

Улучшенная версия

Улучшенную версию процедуры bubbleSort назовём bubbleEnhancedSort. Все улучшения расположены в теле внешнего цикла. Определим и инициализируем нулём переменную $lastSwap, которой после каждого прохода будет присвоена та позиция в списке, где найдётся последняя инверсия. Каждый проход завершается присваиванием переменной $right этого найденного значения:

Perl
my $lastSwap=0;
for(my $i=0; $i<$right; $i++)
{
	if($_[$i]>$_[$i+1])
	{
		@_[$i, $i+1]=@_[$i+1, $i];
		$lastSwap=$i;
	}
}
$right=$lastSwap;

Если проход завершился, а инверсий не обнаружено, переменная $lastSwap так и останется нулевой; нулевое значение получит и переменная $right, и следующий проход не состоится. К этому, собственно говоря, мы и стремились, улучшая пузырьковую сортировку.

Шейкерная сортировка

Процедура shakerSort, осуществляющая шейкерную сортировку, будет отличаться от bubbleEnhancedSort наличием ещё одного внутреннего цикла для обратного прохода:

Perl
sub shakerSort
{
	my $left=0;
	my $right=$#_;

	while($left<$right)
	{
		my $lastSwap;

		for(my $i=$lastSwap=$left; $i<$right; $i++)
		{
			if($_[$i]>$_[$i+1])
			{
				@_[$i, $i+1]=@_[$i+1, $i];
				$lastSwap=$i;
			}
		}
		$right=$lastSwap;

		for(my $i=$lastSwap=$right; $i>$left; $i--)
		{
			if($_[$i]<$_[$i-1])
			{
				@_[$i, $i-1]=@_[$i-1, $i];
				$lastSwap=$i;
			}
		}
		$left=$lastSwap;
	}
	return @_;
}

На этот раз задействована дополнительная переменная $left, указывающая левую границу рабочего участка массива. После обратного прохода она перемещается вправо, в место последнего обмена при обратном проходе.

Сортировка вставками

В теле процедуры insertionSort содержится цикл, в котором в переменной $i перебираются индексы начала неотсортированной части массива. Внутри этого цикла располагается другой, предназначенный для поиска индекса места вставки $i-го элемента. Переменная $j, меняющаяся от 0 до $i-1 по завершении внутреннего цикла как раз укажет найденное место. Как только выполнится условие $_[$j]>$_[$i], следует вставить $i-й элемент на $j-е место, сдвинув вправо элементы с индексами от $j до $i-1, после чего внутренний цикл сразу прерывается. Завершается сортировочная процедура, как обычно, возвратом уже отсортированного массива @_:

Perl
sub insertionSort
{
	for my $i(0..$#_)
	{
		for my $j(0..$i-1)
		{
			if($_[$j]>$_[$i])
			{
				❶ вставить $i-й элемент в позицию $j
				last;
			}
		}
	}
	return @_;
}

Вставку ❶ можно запрограммировать с использованием списочного присваивания:

Perl
@_[$j..$i]=@_[$i, $j..$i-1];

Однако мы подозреваем, что этот изящный код может потребовать неоправданных затрат памяти для построения сначала списка индексов $i, $j..$i-1, а затем и списка элементов @_[$i, $j..$i-1]. Имеется другая возможность, не требующая никакой дополнительной памяти. Чтобы перенести $i$ -й элемент на $j$ -е место ( $j < i$ ), нужно выполнить цепочку соседних обменов элементов с индексами $i$ и $i - 1$ , $i - 1$ и $i - 2$ , …, $j + 1$ и $j$ . Для цепочки обменов потребуется ещё один цикл:

Perl
while($j<$i)
{
	@_[$i, $i-1]=@_[$i-1, $i];
	$i--;
}

Сортировка выбором

Тело процедуры selectionSort содержит два цикла, вложенных один в другой. Во внешнем цикле в переменной $i перебираются индексы начала неотсортированного участка, а во внутреннем в переменной $j осуществляется поиск индекса $k минимального элемента, который должен быть перемещён в начало этого участка. Как только минимальный элемент найден, он меняется местами с первым в неотсортированной части (а он, напомним, имеет индекс $i):

Perl
sub selectionSort
{
	for my $i(0..$#_-1)
	{
		my $k=$i;
		for my $j($i+1..$#_)
		{
			$k=$j if $_[$k]>$_[$j];
		}
		@_[$i, $k]=@_[$k, $i];
	}
	return @_;
}

Древесная сортировка

Для реализации древесного алгоритма нам понадобится определить, помимо основной процедуры treeSort, ещё две вспомогательные процедуры: treeAddElement для добавления элементов в упорядоченное бинарное дерево и treeToArray для превращения дерева в массив.

Процедура treeSort получает список, подлежащий сортировке, как параметр, и возвращает его же после сортировки. В её теле создаётся пустое дерево в переменной $tree, которое затем заполняется элементами при многократных вызовах treeAddElement. После построения дерева уже упорядоченный список вычисляется во время вызова treeToArray, и тут же возвращается:

Perl
sub treeSort
{
	my $tree=[];
	treeAddElement($tree, $_) for @_;
	return treeToArray($tree);
}

Единственным параметром процедуры treeToArray будет ссылка на массив, моделирующий дерево. Пустое дерево, как мы договорились, представляется пустым массивом; в этом случае возвращается пустой массив. В остальных случаях возвращается массив, заполненный сначала элементами левого поддерева, корнем дерева, а затем — правого. Для получения списков элементов поддеревьев применяются рекурсивные вызовы той же процедуры:

Perl
sub treeToArray
{
	my $tree=shift;
	return () unless @$tree;
	return (treeToArray($tree->[1]), $tree->[0], treeToArray($tree->[2]));
}

Процедура treeAddElement получает два параметра — дерево и новый элемент. Дальнейшие действия зависят от того, пусто ли дерево. Для непустого дерева добавляемый элемент передаётся либо в левое, либо в правое поддерево, в зависимости от результатов сравнения с корнем. Выражение $n<$tree->[0]? 1: 2 принимает значение 1 или 2. Оно служит для выбора индекса в массиве, расположенного по ссылке $tree. Элемент добавляется в выбранное поддерево посредством рекурсивного вызова. При добавлении элемента в пустое дерево он становится корнем, и появляются поддеревья, оба пустые:

Perl
sub treeAddElement
{
	my $tree=shift;
	my $n=shift;
	if(@$tree)
	{
		treeAddElement($tree->[$n<$tree->[0]? 1: 2], $n);
	}
	else
	{
		@$tree=($n, [], []);
	}
}

Быстрая сортировка

Реализация рекурсивной процедуры (назовём её recursiveSort) довольно проста.

Perl
sub recursiveSort
{
	return () unless @_;
	my $key=shift;
	❶ сформировать локальные «левый» и «правый» массивы @left и @right
	return (recursiveSort(@left), $key, recursiveSort(@right));
}

В массивы @left и @right будут отфильтрованы те элементы массива @_, которые соответственно строго меньше и больше или равны ключевому элементу, изъятому в переменную $key.

В Perl есть удобная встроенная процедура grep, которая осуществляет фильтрацию массивов. Она отбирает из заданного массива только те элементы, которые удовлетворяют определённому условию. Список найденных элементов возвращается. Условие отбора — процедура-селектор: она должна возвратить истинное или ложное значение для заданного в переменной $_ значения. Селектор вызывается для каждого элемента фильтруемого массива (перед вызовом элемент копируется в $_), и, если он возвратит истину, элемент проходит через фильтр:

Perl
@filteredList=grep { тело селектора } @list;

Вот пример использования grep для отбора положительных элементов числового массива:

Perl
@positiveNumbers=grep { $_>0 } @numbers;

Это альтернатива более громоздкому коду:

Perl
for(@numbers)
{
	push(@positiveNumbers, $_) if $_>0;
}

Мы могли бы закодировать фрагмент ❶ следующим элегантным образом:

Perl
my @left=grep { $_<$key } @_;
my @right=grep { $_>=$key } @_;

Однако воздержимся от этого элегантного решения в пользу более эффективного. Очевидно, эти два вызова grep приведут к двукратному перебору элементов массива @_. Но зачем перебирать дважды, когда можно разобрать элементы @_ в правый и левый массивы за один проход:

Perl
my @left;
my @right;

for(@_)
{
	if($_<$key)	{ push @left, $_; }
	else		{ push @right, $_; }
}

Умная сортировка

Компаратор

Как мы уже писали, в Perl имеется встроенная процедура sort, предназначенная для сортировки списков:

Perl
@sortedList=sort @list;

В этом случае подразумевается лексикографическая сортировка.

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

Однако возможно использование этой процедуры для сортировки, основанной на других способах сравнения элементов списка. Для этого программист должен определить процедуру, которая возвращает -1, 0 или 1 в зависимости от того, является ли первый из сравниваемых элементов меньшим, равным или большим, чем второй. Естественно, следует позаботиться, чтобы понятия «больше» и «меньше», заложенные в процедуре сравнения, были бы взаимно-обратными, а понятие «равно» — симметричным. Такая процедура называется компаратором (от англ. compare — сравнивать).

Вот как следует использовать компаратор:

Perl
@sortedList=sort { тело компаратора } @list;

Процедура sort помещает две величины в переменные $a и $b каждый раз, когда их нужно сравнить, а затем вызывает процедуру-компаратор. Из этого и нужно исходить, определяя такую процедуру. Приводим пример сортировки с арифметическим компаратором:

Perl
@sortedList=sort
	{
		if($a<$b)		{ return -1; }
		elsif($a==$b)	{ return 0; }
		else			{ return 1; }
	}
	@list;

Или чуть короче:

Perl
@sortedList=sort
	{
		return -1 if $a<$b;
		return 0 if $a==$b;
		return 1;
	}
	@list;

Или даже так:

Perl
@sortedList=sort { return $a<$b? -1: ($a==$b? 0: 1); } @list;

Или вообще вот так:

Perl
@sortedList=sort { return $a<=>$b; } @list;

Или, наконец, так:

Perl
@sortedList=sort { $a<=>$b } @list;

Встроенный оператор <=> как раз вычисляет результат арифметического сравнения двух числовых величин. В самом последнем примере return опущен, поскольку и без него процедура возвратит последнее вычисленное выражение. Точка с запятой, завершающая блок, необязательна в языке Perl, и этот тот редкий случай, когда мы разрешим себе эту маленькую вольность — опустим её.

Для сортировки в обратном порядке поменяем в компараторе переменные $a и $b местами:

Perl
@sortedList=sort { $b<=>$a } @list;

Если нужно отсортировать строки по их длинам, запрограммируем компаратор, сравнивающий длины:

Perl
@sortedList=sort { (length $a)<=>(length $b) } @list;

В Perl есть оператор-компаратор и для лексикографического сравнения строк: cmp. Поэтому команды

Perl
@sortedList=sort @list;

Perl
@sortedList=sort { $a cmp $b } @list;

равносильны.

Для реализации инверсной сортировки сравнению в компараторе подлежат не сами строки $a и $b, а результаты их инвертирования — смены порядка символов на противоположный. Так, в результате инвертирования строки инвертирование получится строка еинаворитревни. Встроенная процедура reverse может сделать эту работу:

Perl
@sortedList=sort { (reverse $a) cmp (reverse $b) } @list;

Приводим таблицу аналогий между операторами арифметического и лексикографического сравнения:

арифметическое сравнение	лексикографическое сравнение	мнемоник
<	lt	Less Than
<=	le	Less or Equal
==	eq	Equal
>=	ge	Greater or Equal
>	gt	Greater Than
<=>	cmp	CoMPare

Если компаратор оказывается громоздким, или если он используется многократно, есть смысл определить его как отдельную процедуру и дать этой процедуре имя. Тогда вместо тела компаратора при вызове sort следует указывать имя. Определим и используем компаратор, сравнивающий строки независимо от регистра символов (то есть не различая прописные и строчные буквы), как отдельную процедуру. Назовём её iCmp. Ясно, что нечувствительности к регистру можно добиться, если компаратор будет сравнивать не сами строки, а их «заглавные» варианты (то есть строки, получающиеся из заданных в результате их капитализации — замены всех строчных букв на прописные). За капитализацию строк отвечает встроенная процедура uc (от англ. Upper Case — верхний регистр). Определяя отдельный компаратор, следует помнить, что сравниваемые величины передаются в него уже не через переменные $a и $b, а через параметры вызова, то есть в массиве @_.

Perl
sub iCmp
{
	return (uc $_[0]) cmp (uc $_[1]);
}

@sortedList=sort iCmp @list;

И уж поскольку мы упомянули встроенную процедуру uc, нельзя не вспомнить про её компанию — процедуры lc, ucfirst и lcfirst. Первая из них меняет регистр всех букв на нижний, вторая и третья меняет регистр только у первого символа в строке (если это буква), соответственно на верхний или нижний.

	Примечание
	В последнем примере мы могли бы с равным успехом воспользоваться процедурой `lc` вместо `uc`.

Сортировка со многими критериями

Итак, мы умеем сортировать списки в порядке неубывания некоторого значения, вычисляемого для каждого элемента списка. Это значение называют критерием сортировки. Часто возникает необходимость отсортировать список в соответствии с несколькими критериями.

Например, имеется массив, каждый элемент которого представляет собой ссылку на двухэлементный массив с фамилией и именем человека:

Perl(
	['КОЛЕСНИКОВ', 'АНАТОЛИЙ'],
	['ИВАНОВ', 'ПЁТР'],
	['КОЛЕСНИКОВА', 'НАТАЛЬЯ'],
	['КУЗНЕЦОВ', 'ВЛАДИМИР'],
	['КОЛЕСНИКОВ', 'ЕГОР'],
	['ГРИГОРЬЕВА', 'СВЕТЛАНА'],
)

Если бы требовалось упорядочить список людей только по фамилии или только по имени, подошли бы компараторы

Perl
{ $a->[0] cmp $b->[0] }	по фамилии
{ $a->[1] cmp $b->[1] }	по имени

Если же нужно упорядочить массив по фамилиям, а однофамильцев ещё и по имени, может возникнуть соблазн сравнивать в компараторе результат конкатенации фамилии и имени:

Perl
{ $a->[0].$a->[1] cmp $b->[0].$b->[1] }

Увы, этот подход может в некоторых случаях подвести, а именно в тех, когда фамилия одного человека служит началом фамилии другого. Именно это и произойдёт при сравнении несчастных Натальи и Анатолия. Хотя Анатолий и должен стоять раньше в алфавитном списке, чем Наталья (его фамилия «меньше»), для конкатенации фамилии и имени окажется 'КОЛЕСНИКОВАНАТОЛИЙ' gt 'КОЛЕСНИКОВАНАТАЛЬЯ'.

Устранить эту проблему поможет вставка при конкатенации фамилии и имени такого символа между ними, который меньше любой буквы в алфавитном смысле. В этом качестве идеально подходит пробел, а соответствующий компаратор получится таким:

Perl
{ "$a->[0] $a->[1]" cmp "$b->[0] $b->[1]" }

Или, что равносильно, таким:

Perl
{ "@$a" cmp "@$b" }

(напомним, что упоминание массива между двойными кавычками соединяет его элементы через пробелы).

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

Пусть необходимо упорядочить список точек на плоскости, заданных своими декартовыми координатами:

Perl(
	[3, 4],
	[2, 5],
	[3, 3],
	[1, 6],
	[5, 1],
)

После сортировки точки с меньшими абсциссами должны оказаться ближе к началу списка. При равных абсциссах ближе к началу списка должны расположиться точки с меньшими ординатами. Вот нужный компаратор:

Perl
{ $a->[0]<=>$b->[0] or $a->[1]<=>$b->[1] }

Объясним, как это работает. Если абсциссы не равны, выражение $a->[0]<=>$b->[0] отлично от нуля (оно равно плюс или минус единице), и этой информации достаточно, чтобы сравнить точки только лишь по их абсциссам. В этом случае второе выражение, $a->[1]<=>$b->[1], вообще не вычисляется, так как всё выражение в теле компаратора заведомо истинно. Если абсциссы равны, первый операнд операции or принимает ложное значение, и для вычисления значения операции необходимо вычислить второй операнд. Его значение и станет тем, что вычисляется в компараторе.

Подведём итоги. Компататор для сортировки в соответствии со многими критериями получается, если соединить при помощи операции or выражения компараторов для каждого из критериев, взятых по отдельности. Например, для сортировки списка строк сначала по длинам, а при равных длинах — по алфавиту, строится компаратор

Perl
{ length($a)<=>length($b) or $a cmp $b }

Упорядочить список людей по фамилии и по имени не то же самое, что упорядочить по имени и по фамилии. Вдумчивого читателя может удивить, как это согласуется со способом конструирования компараторов со многими критериями: кажется, что если поменять местами операнды операции or, ничего не должно измениться. Но нет, кое-что изменится. В то время как значение выражения length('AB')<=>length('B') or 'AB' cmp 'B' равно 1, значением выражения 'AB' cmp 'B' or length('AB')<=>length('B') будет уже -1. Дело в том, что операция or в Perl не коммутативна. Коммутативной она станет только если интерпретировать результат как логическое значение. В этом смысле оба числа, 1 и -1 равны, поскольку оба обозначают истину.

Перемешивание

Наивный алгоритм

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

Попробуем использовать в качестве ключей в ассоциативном массиве элементы списка, подлежащего перемешиванию, а соответствующие им значения будем получать, вызывая процедуру rand. Для сортировки в соответствии с неубыванием этих случайных чисел применим умную сортировку:

Perl
sub shuffle
{
	my %randoms;
	$randoms{$_}=rand for @_;
	return sort { $randoms{$a}<=>$randoms{$b} } keys %randoms;
}

Это решение будет прекрасно работать для списков, состоящих из уникальных элементов. Если же список содержит повторяющиеся элементы, все повторы будут устранены, так как элементы списка используются в качестве ключей в ассоциативном массиве.

Если нас не устраивает такое поведение (а нас оно не устраивает), будем искать другое решение. Ясно, что элементы списка не годятся в роли ключей. Пусть теперь ключами побудут случайные числа, а соответствующими значениями — элементы списка.

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

Perl
sub shuffle
{
	my %randoms;
	for(@_)
	{
		my $rand;
		do
		{
			$rand=rand;
		}
		while(exists $randoms{$rand});
		$randoms{$rand}=$_;
	}
	return @randoms{sort { $a<=>$b } keys %randoms};
}

Вот наконец и нашлось применение циклу с постусловием! Цикл do … while будет крутиться до тех пор, пока очередной вызов rand не вернёт случайное число, ранее не встречавшееся среди ключей в ассоциативном массиве %randoms. Скорее всего, этот цикл прокрутится лишь по одному разу для каждого элемента списка.

Заслуживает внимания значение, возвращаемое из процедуры. Выражение sort { $a<=>$b } keys %randoms возвращает список случайных чисел (ключей), упорядоченных по неубыванию, а выражение @randoms{…} — список значений из ассоциативного массива %randoms, которые этим значениям соответствуют, причём в соответствующем порядке. Обратите внимание, что если в фигурных скобках указывается список ключей, нужно писать именно @randoms{…}, а не $randoms{…}, как в случае единичного ключа.

Алгоритм Фишера — Йетса — Дурштенфельда

Словесное описание алгоритма Фишера — Йетса — Дурштенфельда без всяких затей перекладывается на язык Perl, так что сразу отошлём читателя к тексту готовой программы в разделе «Алгоритм Фишера — Йетса — Дурштенфельда».


Идеи реализации		Готовая программа