Запрограммируем процедуру 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;

Процедура 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, $_; }
}