 |
|
 |
4.16. Реализация циклических списков
Проблема
Требуется создать циклический список и организовать работу с ним.Решение
Воспользуйтесь функциями unshift и pop (или push и shift) для обычного массива.unshift(@circular, pop(@circular)); # Последний становится первым
push (@circular,
shift(@circular)); # И наоборот
Комментарий
Циклические списки обычно применяются для многократного выполнения одной и той же последовательности действий - например, обработки подключений к серверу. Приведенный выше фрагмент не является полноценной компьютерной реализацией циклических списков с указателями и настоящей цикличностью. Вместо этого мы просто перемещаем последний элемент на первую позицию, и наоборот.sub grab_and_rotate (\@ ) {
my $listref = shift;
my $element = $listref->[0];
push(@listref, shift @>$listref);
return $element;
}
@processes =(1,2, 3, 4, 5 );
while (1) {
$process = grab_and_rotate(@)processes);
print "Handling process $process\n";
sleep 1;
}
> Смотри также --------------------------------
Описание функций unshift и push в perlfunc(1); рецепт 13.13.
4.17. Случайная перестановка элементов массива
Проблема
Требуется случайным образом переставить элементы массива. Наиболее очевидное применение - тасование колоды в карточной игре, однако аналогичная задача возникает в любой ситуации, где элементы массива обрабатываются в произвольном порядке.Решение
Каждый элемент массива меняется местом с другим, случайно выбранным элементом:# fisher_yates_shuffle ( \@аггау ) : генерация случайной перестановки
# массива @аггау на месте sub fisher_yates_shuffle { my $array =
shift;
my $i;
for ($i = @$array; --$i; ) { my $j = int rand ($i+1);
next if $i == $j;
@$array[$i,$j] = @$array[$j,$i], }
}
fisher_yates_shuffle( \@array ); # Перестановка массива @array на
месте Или выберите случайную перестановку, воспользовавшись кодом из примера
4.4:
$permutations = factorial^ scalar @array );
@shuttle = @array [ n2perm( 1+int(rand $permutations), $#array)
]:
Комментарий
Случайные перестановки на удивление коварны. Написать плохую программу перестановки очень просто:sub naive_shuffle { # Не делайте так!
for (my $i = 0; $i < @_; $i++) {
my $j = int rand @_; # Выбрать случайный элемент
($_[$!], $_[$j]) = ($_[$Л, $_[$!]); # Поменять местами
}
}
Такой алгоритм является смещенным - одни перестановки имеют большую вероятность, чем другие. Это нетрудно доказать: предположим, мы получили список из 3 элементов. Мы генерируем 3 случайных числа, каждое из которых может принимать 3 возможных значения - итого 27 возможных комбинаций. Однако для списка из трех элементов существует всего 6 перестановок. Поскольку 27 не делится на 6, некоторые перестановки появляются с большей вероятностью, чем другие. В приведенном выше алгоритме Фишера-Йетса это смещение устраняется за счет изменения интервала выбираемых случайных чисел.
> Смотри также --------------------------------
Описание функции rand в perlfunc(1). Дополнительная информация о случайных
числах приведена в Рецептах 2.7-2.9. В рецепте 4.19 показан другой способ
построения случайных перестановок.
4.18. Программа: words
Описание
Вас когда-нибудь интересовало, каким образом программы типа Is строят столбцы отсортированных выходных данных, расположенных но столбцам, а не по строкам? Например:awk cp
ed login
mount rmdir
sum
basename csh
egrep Is
mt sed
sync
cat date
fgrep mail
mv sh
tar
chgrp dd
gr-ep mkdir
ps sort
touch
chmod df
kill mknod pwd
stty vi
chown echo
In more
rm su
В примере 4.2 показано, как это делается. Пример 4.2. words
#!/usr/bin/perl -w
# words - вывод данных по столбцам
use strict;
my ($item, $cols, $rows, $maxlen);
my ($xpixel, $ypixel, $mask, ©data);
getwinsize();
# Получить все строки входных данных
# и запомнить максимальную длину строки
$maxlen = 1;
while (о) {
my $mylen;
s/\s+$//;
$maxlen = $mylen if (($mylen = length) > $maxlen);
push(@data, $_);
}
$maxlen += 1;
# Определить границы экрана
$cols = int($cols / $maxlen)
# Дополнительный пробел
1;
$rows = int(($ftdata+$cols) / $cols);
# Задать маску для ускорения вычислений
$mask = sprintf("%%-%ds ", $maxlen-1);
# Подпрограмма для обнаружения последнего элемента строки
sub EOL { ($item+1) % $cols == 0 }
# Обработать каждый элемент, выбирая нужный фрагмент
# на основании позиции
for ($item = 0; $item < $rows * $cols; $item++) {
my $target = ($item % $cols) " $rows + int($item/$cols);
my $piece = sprintf($mask, $target < @data ? $data[$target] :
"");
$piece =~ s/\s+$// if EOL(); # Последний элемент не выравнивать
print $piece;
print "\n" if EOL();
}
# Завершить при необходимости
print "\n" if EOL();
# He переносится -- только для Linux
sub getwinsize {
my $winsize = "\0" x 8;
my $TIOCGWINSZ = 0х40087468;
if (ioctl(STDOUT, $TIOCGWINSZ, $winsize)) {
($rows, $cols, $xpixel, $ypixel) = unpack('S4', $winsize);
} else {
$cols = 80;
}
}
Наиболее очевидный способ вывести отсортированный список по столбцам
- последовательно выводить каждый элемент списка, выравнивая его пробелами
до определенной ширины. Когда вывод достигает конца строки, происходит
переход на следующую строку. Но такой вариант хорош лишь тогда, когда строки
читаются слева направо. Если данные должны читаться по столбцам, сверху
вниз, приходится искать другое решение. Программа words представляет собой
фильтр, который генерирует выходные данные по столбцам. Она читает все
входные данные и запоминает максимальную длину строки. После того как все
данные будут прочитаны, ширина экрана делится на длину самой большой входной
записи - результат равен ожидаемому количеству столбцов. Затем программа
входит в цикл, который выполняется для каждой входной записи. Однако порядок
вывода неочевиден. Предположим, имеется список из девяти элементов:
Неправильно Правильно
123 147
456 258
789 369 Программа words производит все необходимые вычисления, чтобы
элементы (1,4,7) выводились в одной строке, (2,5,8) - в другой и (3,6,9)
- в последней строке. Текущие размеры окна определяются вызовом ioctl.
Этот вариант прекрасно работает - в той системе, для которой он был написан.
В любой другой он не подойдет. Если вас это устраивает, хорошо. В рецепте
12.14 показано, как определить размер окна в вашей системе с помощью файла
ioctl.pch или программы на С. Решение из рецепта 15.4 отличается большей
переносимостью, однако вам придется установить модуль с CPAN.
> Смотри также -------------------------------
Рецепт 15.4.
4.19. Программа: permute
Проблема
Вам никогда не требовалось сгенерировать все возможные перестановки массива или выполнить некоторый фрагмент для всех возможных перестановок? Например: % echo man bites dog | permute dog bites man bites dog man dog man bites man dog bites bites man dog man bites dog Количество возможных перестановок для множества равно факториалу числа элементов в этом множестве. Оно растет чрезвычайно быстро, поэтому не стоит генерировать перестановки для большого числа элементов:Размер множества Количество перестановок
1
1
2
2
3
6
4
24
5
120
6
720
7
5040
8
40320
9
362880
10
3628800
11
39916800
12
479001600
13
6227020800
14
87178291200
15
1307674368000
Соответственно, выполнение операции для всех возможных перестановок занимает много времени. Сложность факториальных алгоритмов превышает количество частиц во Вселенной даже для относительно небольших входных значений. Факториал 500 больше, чем десять в тысячной степени!
use Math::BigInt;
sub factorial {
my $n = shift;
my $s = 1;
$s *= $n-while $n > 0;
return $s;
}
print factorial(Math::BigInt->new("500"));
+1220136...(1035 digits total)
Два решения, приведенных ниже, отличаются порядком возвращаемых перестановок. Решение из примера 4.3 использует классический алгоритм списковых перестановок, используемый знатоками Lisp. Алгоритм относительно прямолинеен, однако в нем создаются ненужные копии. Кроме того, в решении жестко закодирован простой вывод перестановок без каких-либо дополнительных действий.
Пример 4.3. tdc-permute
#!/usr/bin/perl -n
# tsc_permute: вывод всех перестановок введенных слов permute([split],
[]);
sub permute {
my @items = @{ $_[0] };
my (giperms = @{ $_[1] };
unless (@items) { print "@perms\n";
} else {
my(@newitems,@newperms,$i);
foreach $i (0 ., $ftitems) { @>newitems = @items;
@newperms = Operms;
unshift(@newperms, splice(@newitems, $i, 1));
permute([@newitems], [Onewperms]);
}
}
}
Решение из примера 4.4, предложенное Марком-Джейсоном Доминусом (Mark-Jason Dominus), более элегантно н работает примерно на 25 % быстрее. Вместо того чтобы рассчитывать все перестановки, программа генерирует н-ю конкретную перестановку. Элегантность проявляется в двух аспектах. Во-первых, в программе удается избежать рекурсии, кроме как при вычислении факториала (который алгоритмом перестановок обычно не используется). Во-вторых, вместо перестановки реальных данных генерируется перестановка целых чисел. В программе для экономии времени использована методика запоминания. Ее суть заключается в том, что функция, которая всегда возвращает конкретный ответ для конкретного набора аргументов, запоминает этот ответ. При следующем вызове с теми же аргументами дальнейшие вычисления уже не потребуются. Функция factorial сохраняет ранее вычисленные значения факториала в закрытом массиве @fact ( 10.3). Функция n2perm вызывается с двумя аргументами: номером генерируемой перестановки (от 0 до N!, где N - размер массива) и индексом последнего элемента массива. Функция n2perm для расчета шаблона перестановки вызывает нодпр01Т)ам-му n2pat. Затем шаблон преобразуется в перестановку целых чисел подпрограммой pat2perm. Шаблон представляет собой список вида (02010), что означает: "Вырезать нулевой элемент, затем второй элемент оставшегося списка, затем нулевой, первый и снова нулевой".
Пример 4.4. mjd-permute
#!/usr/bin/perl -w
# mjd_permute: перестановка всех введенных слов
use strict;
while (о) {
my @>data = split;
my $num_permutations = factorial(scalar @data);
for (my $i=0; $i < $num_permutations; $i++) {
my (Spermutation = @data[n2perm($i, $ftdata)];
print "@permutation\n";
}
}
# Вспомогательная функция: факториал с запоминанием
BEGIN { my Of act = (1);
sub factorial($) { my $n = shift;
return $fact[$n] if defined $fact[$n];
$fact[$n] = $n * factorial($n - 1);
}
}
# n2pat($N, $len) : построить $N-H шаблон перестановки длины $1еп
sub n2pat {
my $i =1;
my $N = shift;
my $len = shift;
my (Spat;
while ($i <= $len + 1) { # На самом деле просто
while ($N) 'o push @)pat, $N % $i;
$N = int($N/$i);
$i++:
}
return @pat;
}
# pat2perm(@pat) : превратить шаблон, возвращаемый n2pat(),
# в перестановку целых чисел. sub pat2perm {
my @pat = @_;
my @source = (0 .. $#pat);
my @perm;
push @perm, splice(@source, (pop @pat), 1) while @>pat;
return @perm;
}
# n2perm($N, $len) : сгенерировать N-ю перестановку S объектов sub
n2perm {
pat2perm(n2pat(@_));
}
> Смотри также ---------------------
Описание функций unshlft и splice в perlfunc(1); рецепты 2.7; 10.3.
|
|
|