Приглашаем посетить
4.8. Вычисление объединения, пересечения и разности уникальных списков
Проблема
Имеются два списка, каждый из которых содержит неповторяющиеся элементы. Требуется узнать, какие элементы присутствуют в обоих списках {пересечение), присутствуют в одном и отсутствуют в другом списке разность) или хотя бы в одном из списков {объединение).
Решение
В приведенных ниже решениях списки инициализируются следующим образом:
@а = (1, 3, 5, 6, 7, 8);
@b = (2, 3, 5, 7, 9);
@iunion = @isect = @diff = ();
%union = %isect = ();
%count =();
Простое решение для объединения и пересечения
foreach $е(@а) { $union{$е} = 1 }
foreach $e (@b) {
if ( $union{$e} ) { $isect{$e} = 1 } Sun-inn {$e} = 1;
}
@union = Keys %union;
@isect = keys %isect;
Идиоматическое решение
foreach $e (@a, Ob) { $union{$e}++ && $isect{$e}++ }
@union = keys %unions;
@isect = keys %isect;
foreach $e (@a, @b) { $count{$e}++ }
foreach $e (keys %count) { push(@union, $e);
if ($count{$e} == 2) {
push @>isect, $e;
} else {
push @diff, $e;
}
}
Косвенное решение
@isect = @diff = @union = ();
foreach $e (@a, @b) { $count{$e}++ }
foreach $e (keys %count) {
push(@)union, $e);
push @{ $count{$e} == 2 ? \@>isect : \@diff }, $e;
}
Комментарий
В первом решении происходит непосредственное вычисление объединения и пересечения двух списков, ни один из которых не содержит дубликатов. Для зп-писи элементов, принадлежащих к объединению и пересечению, используются два разных хэша. Сначала мы заносим каждый элемент первого массива в хэш объединения и ассоциируем с ним истинное значение. Затем при последовательной обработке элементов второго массива мы проверяем, присутствует ли элемент в объединении. Если присутствует, он также включается и в хэш пересечения. В любом случае элемент заносится в хэш объединения. После завершения перебора мы извлекаем ключи обоих хэшей. Ассоциированные с ними значения не нужны.
Второе решение ("Идиоматическое") в сущности делает то же самое, однако для него потребуется хорошее знание операторов Perl (а также awk, С, C++ и Java) ++ и &&. Если ++ находится после переменной, то ее старое значение используется до приращения. Когда элемент встречается впервые, он еще отсутствует в объединении, поэтому первая часть && будет ложной, а вторая часть попросту игнорируется. Когда тот же элемент встретится во второй раз, он уже присутствует в объединении, поэтому мы заносим его и в пересечение.
В третьем решении использован всего один хэш для хранения информации о том, сколько раз встретился тот или иной элемент. Записав элементы обоих массивов в хэш, мы последовательно перебираем его ключи. Каждый ключ автоматически попадает в объединение. Ключи, с которыми ассоциировано значение 2, присутствуют в обоих массивах и потому заносятся в массив нересече-
ния. Ключи с ассоциированным значением 1 встречаются лишь в одном из двух массивов и заносятся в массив разности. В отличие от исходного решения, порядок элементов в выходных массивах не совпадает с порядком элементов входных массивов.
В последнем решении, как и в предыдущем, используется всего один хэш с количеством экземпляров каждого элемента. Однако на этот раз реализация построена на массиве в блоке @{. . .}.
Мы вычисляем не простую, а симметричную разность. Эти термины происходят из теории множеств. Симметричная разность представляет собой набор всех элементов, являющихся членами либо @А, либо @В, но не обоих сразу. Простая разность - набор всех элементов @А, отсутствующих в @В (см. рецепт 4.7).
Смотри также: Аналогичное применение хэшей продемонстрировано в рецептах 4.7 и 4.8.
Проблема
Требуется объединить два массива, дописав все элементы одного из них в конец другого.
Решение
Воспользуйтесь функцией push:
# push push(@ARRAY1, @ARRAY2);
Комментарий
Функция push оптимизирована для записи списка в конец массива. Два массива также можно объединить посредством сглаживания (flattening) списков Perl, однако в этом случае выполняется намного больше операций копирования, чем при использовании push:
@ARRAY1 = ((sarray1, @array2);
Ниже показан пример практического использования push:
members = ("time", "flies");
@initiates = ("an", "arrow");
push(@members, initiates);
#@members содержит элементы ("Time", "Flies", "An", "Arrow")
Если содержимое одного массива требуется вставить в середину другого, воспользуйтесь функцией splice:
splice(@members, 2, 0, "Like", initiates);
print "@members\n";
splice(@members, 0, 1, "Fruit");
splice(@members, -2, 2, "A", "Banana");
print "@members\n";
Результат выглядит так:
Time Flies Like An Arrow Fruit Flies Like A Banana
Смотри также: Описание функции splice и push в perlfunc(1) раздел "List Value Constructors" perldata(l).
Проблема
Требуется обратить массив (то есть переставить элементы в противоположном порядке).
Решение
Воспользуйтесь функцией reverse:
# Обращение @ARRAY дает
@REVERSED @REVERSED = reverse @array;
Также можно воспользоваться циклом for:
for ($i = $"array; $i >= 0: $i--) {
# Сделать что-то с $ARRAY[$i]
}
Комментарий
Настоящее обращение списка выполняется функцией reverse; цикл for просто перебирает элементы в обратном порядке. Если обращенная копия списка не нужна, цикл for экономит память и время.
Если функция reverse используется для обращения только что отсортированного списка, логичнее будет сразу отсортировать список в нужном порядке. Например:
и Два шага: сортировка, затем обращение
ascending = sort { $а cmp $b } @users;
@descending = reverse @ascending;
# Один шаг: сортировка с обратным сравнением
@descending = sort { $b cmp $a } @users;
Смотри также: Описание функции reverse в perlfunc(1). Она используется в рецепте 1.6.
Проблема
Требуется удалить сразу несколько элементов в начале или конце массива.
Решение
Воспользуйтесь функцией splice:
# Удалить $N элементов с начала
@ARRAY (shift $N) @FRONT = splice(@array, 0, $n);
# Удалить $N элементов с конца массива (pop $N)
(SEND = splice(@array, -$n);
Комментарий
Часто бывает удобно оформить эти операции в виде функций:
sub shift2 (\@) {
return splice(@i{$_[0]}, 0, 2);
}
&uu pop2 (\@) {
return splice(@{$_[0]}, 0, -2);
}
Использование функций делает код более наглядным:
@friends = qw(peter paul mary jim tim);
($this, $that) = shift2((^'-tends);
# $this содержит Peter, $i.hat - Paul, # a @friends - Mary, Jim и Tim
@beverages = qw(dew jolt cola sprite fresca);
@pair = pop2(@beverages);
# $pair[0] содержит $sprite, $pair[1] - Fresca,
# a @beverages - (Dew, Jolt, Cola)
Функция splice возвращает элементы, удаленные из массива, поэтому shift2 заменяет первые два элемента @ARRAY ничем (то есть удаляет их) и возвращает два удаленных элемента. Функция pop2 удаляет и возвращает два последних элемента.
В качестве аргументов этим функциям передается ссылка на массив - это сделано для того, чтобы они лучше имитировали встроенные функции shift и pop. При вызове ссылка не передается явно, с использованием символа \. Вместо этого компилятор, встречая прототип со ссылкой на массив, организует передачу массива по ссылке. Преимущества такого подхода - эффективность, наглядность и проверка параметров на стадии компиляции. Недостаток - передаваемый
объект должен выглядеть как настоящий массив с префиксом @, а не как скалярная величина, содержащая ссылку на массив. В противном случае придется добавлять префикс вручную, что сделает функцию менее наглядной:
$line[5] = \@list;
@got = рор2( @{ $line[5] } );
Перед вами еще один пример, когда вместо простого списка должен использоваться массив. Прототип \@ требует, чтобы объект, занимающий данную позицию в списке аргументов, был массивом. $ line [5] представляет собой не массив, а ссылку на него. Вот почему нам понадобился "лишний" знак @.
Смотри также: Описание функции splice в perlfunc; раздел "Prototypes" perlsub(1). Функция splice используется в рецепте 4.9.
Проблема
Требуется найти первый элемент списка, удовлетворяющего некоторому критерию (или индекс этого элемента). Возможна и другая формулировка - определить, проходит ли проверку хотя бы один элемент. Критерий может быть как простым ("Присутствует ли элемент в списке?")', так и сложным ("Имеется список работников, отсортированный в порядке убывания оклада. У кого из менеджеров самый высокий оклад?"). В простых случаях дело обычно ограничивается значением элемента, но если сам массив может изменяться, вероятно, следует определять индекс первого подходящего элемента.
Решение
Перебирайте элементы в цикле to reach и вызовите last, как только критерий будет выполнен:
my($match, $found, $item);
foreach $item(@array) { if ($critenon) {
$match $item; # Необходимо сохранить
$found = 1;
last; }
}
if($found) {
# Сделать что-то с $match } else {
Но тогда почему бы не воспользоваться хэшем?
# Неудачный поиск
}
Чтобы определить индекс, перебирайте все индексы массива и вызывайте last, как только критерий выполнится:
my($i, $match_idx);
for ($i =0; $i < @array: $i++) { if ($critenon) {
$match_idx = $i: # Сохранить индекс last;
} if(defined $match_idx) {
# Найден элемент
$array[$match_idx] } else {
# Неудачный поиск
}
Комментарий
Стандартных механизмов для решения этой задачи не существует, поэтому мы напишем собственный код для перебора и проверки каждого элемента. В нем используются циклы f о reach и for, а вызов last прекращает проверку при выполнении условия. Но перед тем, как прерывать поиск с помощью last, следует сохранить найденный индекс.
Одна из распространенных ошибок - использование функции дгер. Дело в том, что дгер проверяет все элементы и находит все совпадения; если вас интересует только первое совпадение, этот вариант неэффективен.
Если нас интересует значение первого найденного элемента, присвойте его переменной $match. Мы не можем просто проверять $item в конце цикла, потому что ^о reach автоматически локализует' переменную-итератор и потому не позволяет узнать ее последнее значение после завершения цикла (см. рецепт 4.4).
Рассмотрим пример. Предположим, в массиве @employees находится список объектов с информацией о работниках, отсортированный в порядке убывания оклада. Мы хотим найти инженера с максимальным окладом; это будет первый инженер в массиве. Требуется только вывести имя инженера, поэтому нас интересует не индекс, а значение элемента.
foreach $employee (@employees) {
if ( $employee->category() eq 'engineer' ) { $highest_engineer = $employee;
last;
}
} print "Highest paid engineer is: ",
$highest_engineer->name(), "\n";
Термин "локализация" по отношению к переменной означает придание ен локальной области действия. - Примеч. перев.
Если нас интересует лишь значение индекса, можно сократить программу - достаточно вспомнить, что при неудачном поиске $i будет содержать недопустимый индекс. В основном экономится объем кода, а не время выполнения, поскольку затраты на присваивание невелики по сравнению с затратами на проверку элементов списка. Однако проверка условия if ($i < @ARRAY) выглядит несколько туманно по сравнению с очевидной проверкой defined из приведенного выше решения.
for ($i =0; $i < @ARRAY; $i++) {
last if $criterion;
} if ($1 < @ARRAY) {
# Критерий выполняется по индексу
$i } else {
# Неудачный поиск
}
Смотри также: Разделы "For Loops", "Foreach Loops" и "Loop Control" perlsyn(1); описание функции grер в perlfunc(1).
Проблема
Требуется найти все элементы списка, удовлетворяющие определенному критерию.
Проблема извлечения подмножества из списка остается прежней. Вопрос заключается в том, как найти всех инженеров в списке работников, всех пользователей в административной группе, все интересующие вас имена файлов и т. д.
Решение
Воспользуйтесь функцией дгер. Функция применяет критерий ко всем элементам списка и возвращает лишь те, для которых он выполняется:
@РЕЗУЛЬТАТ = greр { КРИТЕРИЙ ($_) } @СПИСОК;
Комментарий
То же самое можно было сделать в цикле to reach:
@РЕЗУЛЬТАТ =();
foreach ( СПИСОК) {
push(@PE3УЛbTAT, $_) if КРИТЕРИЙ ($_);
}
Функция Perl grep позволяет записать всю эту возню с циклами более компактно. В действительности функция grep сильно отличается от одноименной команды UNIX - она не имеет параметров для нумерации строк или инвертирования критерия и не ограничивается проверками регулярных выражений. Например, чтобы отфильтровать из массива очень большие числа или определить, с какими ключами хэша ассоциированы очень большие значения, применяется следующая запись:
@bigs = grep { $_ > 1_000_000 } @nums;
@pigs = grep { $users{$_} > 1e7 } keys %users;
В следующем примере в @matching заносятся строки, полученные от команды who и начинающиеся с "gnat ":
@matching = grep { /"gnat / } 'who';
Или другой пример:
(Sengineers = grep { $_->position() eq 'Engineer' } @employees;
Из массива @employees извлекаются только те объекты, для которых метод position() возвращает строку Engineer.
Grep позволяет выполнять и более сложные проверки:
@secondary_assistance = grep { $_->income >= 26_000 &&
$_->income < 30_000 } (@applicants);
Однако в таких ситуациях бывает разумнее написать цикл.
Смотри также: Разделы "For Loops", "Foreach Loops" и "Loop Control" perlsyn(1), описание функции grep в perlfunc(1); страница руководства whо(1) вашей системы (если есть); рецепт 4.12.
Проблема
Требуется отсортировать список чисел, однако функция Perl sort (но умолчанию) выполняет алфавитную сортировку в ASCII-порядке.
Решение
Воспользуйтесь функцией Perl sort с оператором числового сравнения, оператор <=>:
@Sorted = sort { $a <=> $b } @Unsorted;
Комментарий
При вызове функции sort можно передавать необязательный программный блок, с помощью которого принятый по умолчанию алфавитный порядок сравнения заменяется вашим собственным. Функция сравнения вызывается каждый раз, когда sort сравнивает две величины. Сравниваемые значения загружаются в специальные пакетные переменные $а и $Ь, которые автоматически локализуются.
Функция сравнения должна возвращать отрицательное число, если значение $а должно находиться в выходных данных перед $b; 0, если они совпадают или порядок несущественен; и положительное число, если значение $а должно находиться после $Ь. В Perl существуют два оператора с таким поведением: оператор <=> сортирует числа по возрастанию в числовом порядке, а стр сортирует строки по возрастанию в алфавитном порядке. По умолчанию sort использует сравнения в стиле стр.
Следующий фрагмент сортирует список идентификаторов процессов (PID) в массиве @pids, предлагает пользователю выбрать один PID.и посылает сигнал TERM, за которым следует сигнал KILL. В необязательном программном блоке $а сравнивается с $Ь оператором <=>, что обеспечивает числовую сортировку.
# @pids - несортированный массив идентификаторов процессов
foreach my $pid (sort { $a <=> $b } @pids) {
print "$pid\n", }
print "Select a process ID to kill:\n":
chomp ($pid = <>):
die "Exiting .., \n" unless $pid && $pid =~ /"\d=$/;
kill ('TERM',$pid);
sleep 2;
kill ('KILL',$pid);
При использовании условия $a<:::>$b или $а cmp $b список сортируется в порядке возрастания. Чтобы сортировка выполнялась в порядке убывания, достаточно поменять местами $а и $Ь в функции сравнения:
@descending = sort { $b <=> $а } @unsorted;
Функции сравнения должны быть последовательными; иначе говоря, функция всегда должна возвращать один и тот же ответ для одинаковых величин. Непоследовательные функции сравнения приводят к зацикливанию программы или ее аварийному завершению, особенно в старых версиях Perl.
Также возможна конструкция вида sort ИМЯ СПИСОК, где ИМЯ - имя функции сравнения, возвращающей -1,0 или +1. В интересах быстродействия нормальные правила вызова не соблюдаются, а сравниваемые значения, как по волшебству, появляются в глобальных пакетных переменных $а и $Ь. Из-за особенностей вызова этой функции в Perl рекурсия в ней может не работать.
Предупреждение: значения $а и $Ь задаются в пакете, активном в момент вызова sort, - а он может не совпадать с пакетом, в котором была откомпилирована передаваемая sort функция сравнения (ИМЯ)! Например:
package Sort_Subs;
sub revnum { $b <=> $a }
package Other_Pack;
@all = sort sort_subs: : revnum 4, 19, 8, 3;
Такая попытка тихо закапчивается неудачей - впрочем, при наличии ключа -w о неудаче будет заявлено вслух. Дело в том, что вызов sort создает пакетные переменные $а и $Ь в своем собственном пакете, Other_Pack, а функция revnum будет использовать версии из своего пакета. Это еще один аргумент в пользу встроенных функций сортировки:
@аll = sort { $b <=> $а } 4, 19, 8, 3;
За дополнительной информацией о пакетах обращайтесь к главе 10 "Подпрограммы".
Смотри также: Описание операторов стр и <=> в реrlор(1); описание функций kill, sort и sleep в perlfunc(1); рецепт 4.15.
Проблема
Требуется отсортировать список, руководствуясь более сложным критерием, нежели простыми строковыми или числовыми сравнениям.
Такая проблема часто встречается при работе с объектами или сложными структурами данных ("отсортировать но третьему элементу массива, на который указывает данная ссылка"). Кроме того, она относится к сортировке по нескольким ключам - например, когда список сортируется по дню рождения, а затем по имени (когда у нескольких людей совпадают дни рождения).
Решение
Воспользуйтесь нестандартной функцией сравнения в sort:
@ordered = sort { compare() } @unordered;
Для ускорения работы значение поля можно вычислить заранее:
(Sprecomputed = map { [computeq, $_] } @unordered;
@ordered_precomputed = sort { $a->[0] <=> $b->[0] } @iprecomputed;
@ordered = map { $_->[1] } @ordered_precomputed;
Наконец, эти три шага можно объединить:
@ordered = map { $_->[1] }
sort { $a->[0] <=> $b->[0] } map { [computeO, $_] } @unordered;
Комментарий
О том, как пользоваться функциями сравнения, рассказано в рецепте 4.14. Помнимо использования встроенных операторов вроде <=>, можно конструировать более сложные условия:
@ordered = sort { $a->name cmp $b->name } @employees;
Функция sort часто используется подобным образом в циклах foreach:
foreach $employee (sort {$a->name cmp $b->name } @employees) { print $etTiployee->nanie,
" earns \$", $employee->salary, "\n";
Если вы собираетесь много работать с элементами, расположенными в определенном порядке, эффективнее будет сразу отсортировать их и работать с отсортированным списком:
@sorted_employees = sort { $a->name cmp $b->name } @employees;
foreach $employee (iasorted_employees) {
print $employee->name, "earns \$", $employee->salary, "\n";
}
# Загрузить %bonus
roreach $employee (@lsoгted_empioyees) {
if ($bonus{ $employee->ssn } ) {
print $employee->name, "got a bonus'\n":
}
}
В функцию можно включить несколько условий и разделить их операторами |. Оператор [ | возвращает первое истинное (ненулевое) значение. Следовательно, сортировку можно выполнять по одному критерию, а при равенстве элементов (когда возвращаемое значение равно 0) сортировать но другому критерию. Получается "сортировка внутри сортировки":
@sorted = sort {$a->name cmp $b->name
$b->age <=> $a->age} @employees;
Первый критерий сравнивает имена двух работников. Если они не совпадают, I прекращает вычисления и возвращает результат cmp (сортировка в порядке возрастания имен). Но если имена совпадают, | ] продолжает проверку и возвращает результат <=> (сортировка в порядке убывания возраста). Полученный список будет отсортирован по именам и по возрасту в группах с одинаковыми именами.
Давайте рассмотрим реальный пример сортировки. Мы собираем информацию обо всех пользователям в виде объектов User:: pwent, после чего сортируем их по именам и выводим отсортированный список:
use User::pwent qw(getpwent);
@users =();
# Выбрать всех пользователей
while (defined($user = getpwent)) { push(@users, $user);
} users = sort { $a->name cmp $b-users;
foreach $user (@users) { print $user->name, "\n";
}
Возможности не ограничиваются простыми сравнениями или комбинациями простых сравнений. В следующем примере список имен сортируется по второй букве имени. Вторая буква извлекается функцией substr:
@sorted = sort { substr($a,1,1) cmp substr($b, 1,1) } @names;
А ниже список сортируется по длине строки:
@sorted = sort { length $a <=> length $b } @strings;
Функция сравнения вызывается sort каждый раз, когда требуется сравнить два элемента. Число сравнений заметно увеличивается с количеством сортируемых элементов. Сортировка 10 элементов требует (в среднем) 46 сравнений, однако при сортировке 1000 элементов выполняется 14000 сравнений. Медленные' операции (например, split или вызов подпрограммы) при каждом сравнении тормозят работу программы.
К счастью, проблема решается однократным выполнением операции для каждого элемента перед сортировкой. Воспользуйтесь тар для сохранения результатов операции в массиве, элементы которого являются анонимными массивами с исходным и вычисленным нолем. Этот "массив массивов" сортируется по предварительно вычисленному полю, после чего тар используется для получения отсортированных исходных данных. Концепция map/sort/map применяется часто и с пользой, поэтому ее стоит рассмотреть более подробно.
Применим ее к примеру с сортировкой по длине строки:
@temp = map { [ length $_, $_ ] } @strings;
@temp = sort { $a->[0] <=> $b->[0] } @temp;
""sorted = map { $_->[1] } @temp;
В первой строке map создает временный массив строк с их длинами. Вторая строка сортирует временный массив, сравнивая их предварительно вычисленные длины. Третья строка превращает временный массив строк/длин в отсортированный массив строк. Таким образом, длина каждой строки вычисляется всего один раз.
Поскольку входные данные каждой строки представляют собой выходные данные предыдущей строки (массив @temp, созданный в строке 1, передается sort в строке 2, а результат сортировки передается тар в строке 3), их можно объединить в одну команду и отказаться от временного массива:
@sorted = map { $_->["! ] }
sort {$a->[0] <=> $b->[0] } map { [ length $_, $_] } @strings;
Теперь операции перечисляются в обратном порядке. Встречая конструкцию map/sort/map, читайте ее снизу вверх:
(@strings: в конце указываются сортируемые данные. В данном случае это массив, но как вы вскоре убедитесь, это может быть вызов подпрограммы или даже команда в обратных апострофах. Подходит все, что возвращает список для последующей сортировки.
тар: нижний вызов тар строит временный список анонимных массивов. Список содержит пары из предварительно вычисленного поля (length $_) и исходного элемента ($_). В этой строке показано, как происходит вычисление поля.
sort: список анонимных массивов сортируется посредством сравнения предварительно вычисленных полей. По этой строке трудно о чем-то судить - разве что о том, будет ли список отсортирован в порядке возрастания или убывания.
тар: вызов тар в начале команды превращает отсортированный список анонимных массивов в список исходных отсортированных элементов. Как правило, во всех конструкциях map/sort/map он выглядит одинаково.
Ниже показан более сложный пример, в котором сортировка выполняется по первому числу, найденному в каждой строке fields:
@temp = map { [ /(\d+.)/, $_ ] } @fields;
@sorted_temp = sort {$a->[0] <=> $b->[0] } @temp:
@sorted_fields = map { $_->[1] } @sorted_temp;
Регулярное выражение в первой строке извлекает из строки, обрабатываемой тар, первое число. Мы используем регулярное выражение /(\d+)/ в списковом контексте.
Из этого фрагмента можно убрать временный массив. Код принимает следующий вид:
@sorted_fields = map { $_->[1] }
sort { $a->[0] <=> $b->[0] } map { [ /(\d+)/, $_ ] } @fields;
В последнем примере выполняется компактная сортировка данных, разделенных запятыми (они взяты из файла UNIX passwd). Сначала выполняется числовая сортировка файла по четвертому нолю (идентификатору группы), затем - числовая сортировка по третьему полю (идентификатору пользователя) и алфавитная сортировка по первому полю (имени пользователя).
print map { $_->[0] } # Целая строка sort {
$а->[1] <=> $b->[1] # Идентификатор группы
$а->[2] <=> $b->[2] # Идентификатор пользователя
$а->[3] <=> $b->[3] # Имя пользователя
}
mар { [ $_, (split /:/)[3,2,0] ] } 'cat /etc/passwd';
Компактная конструкция map/sort/map больше напоминает программирование на Lisp и Scheme, нежели обычное наследие Perl - С и awk. Впервые она была предложена Рэндалом Шварцем (Randal Schwartz) и потому часто называется "преобразованием Шварца".
Смотри также: Описание функции sort в реrlfunс(1), описание операторов стр и <=> в perlop(1); рецепт 4.14.
