Приглашаем посетить
5.11. Поиск общих или различающихся ключей в двух хэшаx
Проблема
Требуется найти в хэше ключи, присутствующие в другом хэше, - или наоборот, не входящие в другой хэш.
Решение
Организуйте перебор ключей хэша с помощью функции keys и проверяйте, присутствует ли текущий ключ в другом хэше.
Поиск общих ключей
mу @соmmоn = ();
foreach (keys %hash1) {
push(@common, $_) if exists $hash2{$_};
} # Ocommon содержит общие ключи
Поиск ключей, отсутствующих в другом хэше
my @this_not_that = ();
foreach (keys %hash1) {
push(@this_not_that, $_) unless exists $hash2{$_};
}
Комментарий
При поиске общих или различающихся ключей хэшей можно воспользоваться рецептами для поиска общих или различающихся элементов в массивах ключей хэшей. За подробностями обращайтесь к рецепту 4.8.
В следующем фрагменте поиск различающихся ключей применяется для нахождения продуктов, не входящих в хэш с описаниями цитрусовых:
# Хэш %food_color определяется во введении
# %citrus_color - хэш, связывающий названия цитрусовых плодов с их цветами
%citrus_color = (Lemon => "yellow",
Orange => "orange",
i -i mp => "green" );
# Построить список продуктов, не входящих в хэш цитрусовых @non-citrus = ();
foreach (keys %food_color) {
push (@non_citrus, $_) unless exists $citrus_color{$_};
}
Смотри также: Описание функции each в perlfunc(l). Срезы хэшей рассматриваются в perldata(\.}.
Проблема
Если функция keys вызывается для хэша, ключи которого представляют собой ссылки, то возвращаемые ей ссылки не работают. Подобная ситуация часто возникает при создании перекрестных ссылок в двух хэшах.
Решение
Воспользуйтесь модулем Tie::RefHash:
use Tie::RefHash;
tie %hash, "Tie: :Refhtas";
# Теперь в качестве ключей хэша %hash можно использовать ссылки
Комментарий
Ключи хэшей автоматически преобразуются в строки - то есть интерпретируются так, словно они заключены в кавычки. Для чисел и строк при этом ничего не теряется. Однако со ссылками дело обстоит иначе.
После преобразования в строку ссылка принимает следующий вид:
Class::Somewhere=hash(ox72048) array(ox72048)
Преобразованную ссылку невозможно вернуть к прежнему виду, поскольку она перестала быть ссылкой и превратилась в обычную строку. Следовательно, при использовании ссылок в качестве ключей хэша они теряют свои "волшебные свойства".
Для решения этой проблемы обычно создается специальный хэш, ключами которого являются ссылки, преобразованные в строки, а значениями - настоящие ссылки. Именно это и происходит в модуле Tie::RefHash. Мы воспользуемся объектами ввода/вывода для работы с файловыми манипуляторами и покажем, что даже такие странные ссылки могут использоваться для индексации хэша, связанного с Tie::RefHash.
Приведем пример:
use Tie::RefHash;
use IO::File;
tie %name, "Tie::RefHash";
foreach $filename ("/etc/termcap","/vmunix", "/bin/cat") {
$fh = 10: :file->("< $filename") or next;
$name{$fh} = $filename;
}
print "open files: ", join(", values %name", "\n";
foreach $file (keys %name) {
seek($file, 0, 2); # Позиционирование в конец файла
printf("%s is %d bytes long.\n", $name{$file}, tell($file));
}
Однако вместо применения объекта в качестве ключа хэша обычно достаточно сохранить уникальный атрибут объекта (например, имя или идентификатор).
Смотри также: Документация по стандартному модулю Tie::RefHash; раздел "Warning" perl-re/(l).
Проблема
Требуется заранее выделить память под хэш, чтобы ускорить работу програм-г/:н - в этом случае Perl не придется выделять новые блоки при каждом добавлении элемента. Окончательный размер хэша часто бывает известен в начале построения, и эта информация пригодится для повышения быстродействия.
Решение
Присвойте количество пар "ключ/значение" конструкции keys(%X3lU):
# Выделить в хэше %hash память для $num элементов.
keys(%hash) = $num;
Комментарий
Новая возможность, впервые появившаяся в Perl версии 5.004, может положительно повлиять на быстродействие вашей программы (хотя и не обязательно). В хэшах Perl и так применяются общие ключи, поэтому при наличии хэша с ключом "Apple" Perl уже не выделяет память под другую копию "Apple" при включении этого ключа в другой хэш.
# В %users резервируется место для 512 элементов.
keys(%users) = 512;
Внутренние структуры данных Perl требуют, чтобы количество ключей было равно степени 2. Если написать:
keys(%users) = 1000;
Perl выделит для хэша 1024 "гнезда". Количество ключей не всегда равно количеству гнезд. Совпадение обеспечивает оптимальное быстродействие, однако конкретное соответствие между ключами и гнездами зависит от ключей и внутреннего алгоритма хэширования Perl.
Смотри также: Функция keys описана в perlfunc(1). Также обращайтесь к рецепту 4.3.
Проблема
Имеется сложная структура данных (например, массив или хэш). Требуется узнать, как часто в ней встречается каждый элемент массива (или ключ хэша). Допустим, в массиве содержатся сведения о транзакциях Web-сервера и вы хотите узнать, какой файл запрашивается чаще остальных. Или для хэша, в котором имя пользователя ассоциируется с количеством регистрации в системе, требуется определить наиболее распространенное количество регистрации.
Решение
Воспользуйтесь хэшем и подсчитайте, сколько раз встречается тот или иной элемент, ключ или значение:
%count =();
foreach $element (@array) {
$count{$element}++:
}
Комментарий
Каждый раз, когда возникает задача подсчета различных объектов, вероятно, стоит воспользоваться хэшем. В приведенном выше цикле f о reach для каждого экземпляра $element значение $count{$element} увеличивается на 1.
Смотри также: Рецепты 4.6 и 4.7.
Проблема
Требуется представить отношения между данными - например, отношения "предок/потомок" в генеалогическом дереве или "родительский/порожденный процесс" в таблице процессов. Задача тесно связана с представлением таблиц в реляционных базах данных (отношения между записями) и графов в компьютерных технологиях (отношения между узлами графа).
Решение
Воспользуйтесь хэшем.
Комментарий
Следующий хэш представляет часть генеалогического дерева из Библии:
%father = (
'Cain' => 'Adam',
'Abel' => 'Adam',
'Seth' => 'Adam',
'Enoch' => 'Cain',
'Irad' => 'Enoch',
'Mehujael' => 'Irad',
'Methusael' => 'Mehujael',
'Lamech' => 'Methusael',
'Jabal' => 'Lamech',
'Jubal' => 'Lamech',
'Tubalcain' => 'Lamech',
'Enos' =>'Seth' );
Например, мы можем легко построить генеалогическое дерево любого персонажа:
while (о) { chomp;
do {
print "$_ "; # Вывести текущее имя
$_ = $father{$_}; # Присвоить $_ отца $_ } while defined;
# Пока отцы находятся
print "\n";
}
Просматривая хэш %father, можно отвечать на вопросы типа: "Кто родил Сета?" При инвертировании хэша отношение заменяется противоположным. Это позволяет использовать рецепт 5.8 для ответов на вопросы типа: "Кого родил Ламех?"
while ( ($k, $v) = each %father ) { push( @>{ $children<$v} }, $k );
}
$"=','; # Выходные данные разделяются запятыми
while (о) {
chomp;
if ($children{$_}) {
@children = @{$children{$_}};
} else {
@children = "nobody";
}
print "$_ begat children.\n";
}
Хэши также могут представлять такие отношения, как директива #include языка С - А включает В, если А содержит "include В. Следующий фрагмент строит хэш (он не проверяет наличие файлов в /usr/include, как следовало бы, но этого можно добиться ценой минимальных изменений):
foreach $file (Ofiles) {
local *F; # На случай, если понадобится
# локальный файловый манипулятор unless (open (F, "<$file")) {
warn "Couldn't read file: $!; skipping.\n";
next;
}
while () {
next unless /"\s*#\s+include\s+<([">\+)>/;
push(@{$includes{$1}}, $file);
} close F;
}
Другой фрагмент проверяет, какие файлы не включают других:
@include_free = (); # Список файлов, не включающих других файлов
@uniq{map { @$_ } values %includes} = undef;
foreach $file (sort keys %uniq) {
push( @include_free , $file ) unless $includes{$file};
}
Результат values %includes представляет собой анонимный массив, поскольку один файл может включать (и часто включает) сразу несколько других файлов. Мы используем тар для построения большого списка всех включенных файлов и удаляем дубликаты с помощью хэша.
Смотри также: Рецепт 4.6; описание более сложных структур данных в рецептах 11.9-11.14.
Программа dutree (см. пример 5.3) преобразует выходные данные du:
% du cookbook
19 pcb/fix
20 pcb/rev/maybe/yes
10 pcb/rev/maybe/not
705 pcb/rev/maybe
54 pcb/rev/web
1371 pcb/rev
3 pcb/pending/mine
1016 pcb/pending
2412 pcb
в отсортированную иерархическую структуру с расставленными отступами
Аргументы передаются программе dutree через du. Это позволяет вызвать dutree любым из приведенных ниже способов, а может быть, и иначе - если ваша версия du поддерживает другие параметры.
% dutree
% dutree /usr
% dutree -a
% dutree -a /bin
Хэш %Dirsize сопоставляет имена с размерами файлов. Например, значение $Dirsize{"pcb"} в нашем примере равно 2412. Этот хэш используется как для вывода, так и для сортировки подкаталогов каждого каталога по размерам.
Хэш %Kids представляет больший интерес. Для любого пути $path значение $Kids{path} содержит (ссылку на) массив с именами подкаталогов данного каталога. Так, элемент с ключом "pcb" содержит ссылку на анонимный массив со строками "fix", "rev" и "pending". Элемент "rev" содержит "maybe" и "web". В свою очередь, элемент "maybe" содержит "yes" и "по", которые не имеют собственных элементов, поскольку являются "листами" (конечными узлами) дерева.
Функции output передается начало дерева - последняя строка, прочитанная из выходных данных du. Сначала функция выводит этот каталог и его размер, затем сортирует его подкаталоги (если они имеются) так, чтобы подкаталоги наибольшего размера оказались наверху. Наконец, output вызывает саму себя, рекурсивно перебирая все подкаталоги. Дополнительные аргументы используются при форматировании.
Программа получается рекурсивной, поскольку рекурсивна сама файловая система. Однако ее структуры данных не рекурсивны - по крайней мере, не в том смысле, в котором рекурсивны циклические связанные списки. Каждое ассоциированное значение представляет собой массив ключей для дальнейшей обработки. Рекурсия заключается в обработке, а не в способе хранения.
Пример 5.3. dutree
#!/usr/bin/perl -w
# dutree - печать сортированного иерархического представления
# выходных данных du use strict;
my %Dirsize;
my %Kids;
getdots(my $topdir = input());
output($topdir);
# Запустить du, прочитать входные данные, сохранить размеры и подкаталоги
# Вернуть последний прочитанный каталог (файл?)
sub input {
my($size, $name, $parent);
@ARGV = ("du @argv |"); # Подготовить аргументы while (о)
(
$size, $name) = split;
$Dirsize{$name} = $size;
($parent = $name) =~ s#/["/]+$##; # Имя каталога .
push @{ $Kids{$parent} }, $name unless eof;
} return $name;
}
# Рассчитать, сколько места занимают файлы каждого каталога,
# не находящиеся в подкаталогах. Добавить новый фиктивный
# подкаталог с именем ".", содержащий полученную величину.
sub getdots {
my $coot = $_[0];
my($size, $cursize);
$size = $cursize = $dirsize{$root};
if ($Kids{$root}) {
for my $kid (@{ $Kids{$root} }) { $cursize -= $dirsize{$kid};
getdots($kid);
}
}
if ($size != $cursize) { my $dot = "$root/,";
$Dirsize{$dot} = $cursize;
push @>{ $Kids{$root} }, $dot;
}
}
# Рекурсивно вывести все данные,
# передавая при рекурсивных вызовах
# выравнивающие пробелы и ширину числа
sub output {
my($root, $prefix, $width) = (shift, shift || '', shift || 0);
my $path;
($path = $root) =~ s#.*/##; # Базовое имя my $size = $dirsize{$root};
my $line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n";
for ($prefix .= $line) { # Дополнительный вывод
s/\d /I /;
s/["|]/ /g;
} if ($Kids{$root}) { # Узел имеет подузлы
my OKids = @{ $kids{$root} };
@Kids = sort { $dirsize{$b} <=> $Dirsize{$a} } OKids;
$Dirsize{$Kids[0]} =~ /(\d+)/;
my $width = length $1;
for my $kid (@>Kids) { output($kid, $prefix, $width) }
}
}
До того как в Perl появилась прямая поддержка хэшей массивов, эмуляция подобных конструкций высшего порядка требовала титанических усилий. Некоторые программисты использовали многократные вызовы splitujoin,HO это работало чрезвычайно медленно.
В примере 5.4 приведена версия программы dutree из тех далеких дней. Поскольку у нас не было прямых ссылок на массивы, приходилось самостоятельно залезать в символьную таблицу Perl. Программа на ходу создавала переменные с жутковатыми именами. Удастся ли вам определить, какой хэш используется этой программой?
Массив @{"pcb"} содержит ссылку на анонимный массив, содержащий "pcb/ fix", "pcb/rev" и "pcb/pending". Массив @{"pcb/rev"} содержит "pcb/rev/maybe" и "pcb/rev/web". Массив @{ "pcb/rev/maybe"} содержит "pcb/rev/maybe/yes" и "pcb/rev/maybe/not".
Когда вы присваиваете *kid что-нибудь типа "pcb/fix", строка в правой части преобразуется в тип-глоб. @kid становится синонимом для @{" pcb/fix"}, но это отнюдь не все. &kid становится синонимом для &{ "pcb/fix"} и т. д.
Если эта тема покажется неинтересной, подумайте, как local использует динамическую область действия глобальных переменных, чтобы избежать передачи дополнительных аргументов. Заодно посмотрите, что происходит с переменной width в процедуре output.
Пример 5.4. dutree-orig
#!/usr/bin/perl
# dutree_orig: старая версия, которая появилась
# до выхода реrl5 (начало 90-х)
@lines = 'du @argv;
chop(@lines);
&input($top = pop @lines);
&output($top);
exit;
sub input {
local($root, *kid, $him) = @_[0,0];
while ((alines && &childof($root, $lines[$#lines])) {
&input($him = pop(@lines));
push(@kid, $him);
i}
if (@kid) {
local($mysize) = ($root =~ /"(\d+)/);
for (@kid) { $mysize -= (/~(\d+)/)[0]; }
push(@kid, "$mysi2e .") if $size != $mysize;
} @kid = &sizesort(*kid);
}
sub output {
local($root, *kid, $prefix) =@_[0,0,1];
local($size, $path) = split(' ', $root);
$path =~ s!.*/!!;
$line = sprintf("%${width}d %s", $size, $path);
print $prefix, $line, "\n":
$prefix .= $line;
$prefix =~ s/\d /i /;
$prefix =- s/[-]]/ /g;
local($width) = $kid[0] =~ /(\d+)/ && length("$1");
for (@kid) { &output($_, $prefix); };
}
sub sizesort {
local(*list, Oindex) = shift;
sub b.ynum { $index[$b] <=> $index[$a]; } for (@list) { push(@index, /(\d+)/); } @list[sort bynum 0..$#list];
}
sub childof {
local(@pair) = @_;
for (Opair) { s/-\d+\s+//g; s/$/\//: }
index($pair[1], $pair[0]) >= 0;
}
Итак, какой же хэш используется старой программой dutree? Правильный ответ - %main: :, то есть символьная таблица Perl. He стоит и говорить, что эта программа не будет работать с use strict. Мы рады сообщить, что новая версия работает втрое быстрее старой. Дело в том, что старая версия постоянно ищет переменные в символьной таблице, а новая обходится без этого. Кроме того, нам удалось избежать медленных вызовов split для занимаемого места и имени каталога. Однако мы приводим и старую версию, поскольку она весьма поучительна.
