Перевод Anton Petrusevich <casus@mail.ru> и Alex Ott <ott@phtd.tpu.edu.ru>
Каждый день мы встречаемся с телефонными номерами, которые ``произносятся'', например как ``please dial 1-ZZZ-HE-MUST-PAY to force your older brother to pay for the call!''. Это происходит поскольку в ранние дни телефонного сервиса с (когда были телефоны использующие наборные диски), для каждой цифры сопоставлялась буква.
В одном из списков рассылки, который я читаю, поступил вопрос:
кто-то хотел знать, существуют ли большие наборы слов, которые
вступают в противоречие с теми же номерами. Я подумал, что это было бы отличной
работой для Perl и через короткое время написал программу, которая
проходит по всем словам стандартного словаря Unix, который расположен
в /usr/dict/words, для того, чтобы найти самый длинный список
сталкивающихся слов (или списки, если существует более
одного). Поскольку программа демонстрирует некоторую базовую технику
сокращения данных, то я решил продемонстрировать ее и вам.
Сначала идет самая критическая часть. Задавая произвольную строку,
например ``merlyn'', какие цифры будут использоваться для ее создания?
Hам необходимо знать, что m равно 6, а e равно 3, и
так далее. Самым быстрам способом для выполнения этой операции является
оператор tr:
$_ = "merlyn";
tr[abcdefghijklmnoprstuvwxy]
[222333444555666777888999];
print;
что выдает 637596. Здесь я использовал свойство, которое разрешает
операндам tr быть разделенными произвольными,
сбалансированными знаками пунктуации, вместе с возможным пустым
пространством между двумя списками. Это дает нам великолепное
видимое расположение, что позволяет сне проверить, что я получаю
правильные символы с правильным переводом.
Давайте оформим этот код как подпрограмму, добавив две
дополнительных возможности: (1) Прописные символы будут обрабатываться
как строчные, и (2) если в строке имеется что-то не входящее в этот
список (например символы Q или Z или знаки препинания), то будет
возвращаться значение undef:
sub translate {
local $_ = lc shift;
return unless
tr[abcdefghijklmnoprstuvwxy]
[222333444555666777888999]
== length;
$_;
}
Превращение прописных букв в строчные выполняется очень легко,
выполняя функцию lc над результатом полученным с помощью
оператора shift из массива аргументов @_.
Передача ``плохих символов'' обрабатывается, путем отслеживания
чтобы число символов преобразованных с помощью оператора tr
(он возвращает значение) было равным длине переданной строки. В
противном случае возвращается значение undef.
Теперь нам необходимо пройти по словарю, Это не очень сложно; нам просто необходимо преобразовать каждое слово, а затем сохранить результаты. Если мы используем хеш, ключом которого является преобразованное число, то каждый элемент хеша может иметь значение ссылки на массив всех слов, которым соответствует данный номер, Это выглядит примерно так:
my %num_to_words;
@ARGV = "/usr/dict/words" unless @ARGV;
while (<>) {
chomp;
next unless
my $translate = translate($_);
push @{$num_to_words{$translate}}, $_;
}
Мы используем аргументы командной строки, перечисленные в массиве
@ARGV, как список обрабатываемых файлов, используя
/usr/dict/words как значение по умолчанию, если аргументы не
заданы. И мы будем считать значение $num_to_words{$translate}
ссылкой на массив, помещая каждое новое слово в конец массива. Если
записей не существует (например в начале работы), то Perl помещает
ссылку на пустой массив в значение, позволяя выполнять операцию
push.
Так, что если словарь состоит только из слов merlyn,
Randal и pamfan, то у нас будет следующая структура
данных:
%num_to_words = (
"637596" => ["merlyn"],
"725325" => ["Randal", "pamfan"],
);
Каждый из ключей в хеше является преобразованным числом. Каждое значение является ссылкой на массив, состоящий из слов, которые имеют данное преобразованное число. Если у нас имеется более одной записи, то у нас есть противоречия. Чем больше лист столкновений, тем он интересней для нас.
Например, заметьте, что выдуманное слово ``pamfan'' сталкивается со
словом ``Randal'', создавая список из двух объектов. Это более
интересно, чем слово merlyn, которое преобразуется в отдельное
число.
Так что теперь, необходимо пройти по полученной структуре данных, и найти самый длинный список столкновений. Для начала, нам необходимо выполнить цикл и измерить длину каждого из списков:
for my $number (keys %num_to_words) {
my $length = @{$num_to_words{$number}};
...
}
Этот код использует ссылку на массив из значения хеша, выполняя
разыменование его в скалярном контексте, так что в результате мы
получаем количество значений в массиве. Если у нас имеется пять
значений, которые соответствуют числу $number, то результат
будет равен 5.
И мы захотим сохранить информацию о самой длинной записи. Одним из способов является хранение двух значений, первое из которых инициализируется за пределами цикла:
my $maxlength = 0;
my @longest;
Мы будем использовать $maxlength для сохранения
максимальной длины списка и будем помещать значения в список
@longest для тех чисел6 чья длина совпадает с максимальной
длиной списка. Если новое значение $length больше текущего
максимального значения, то мы начинаем заново заполнять массив:
...
if ($length > $maxlength) {
$maxlength = $length;
@longest = $number;
} elsif ($length == $maxlength) {
push @longest, $number;
}
...
Это значит, что если длина просматриваемой нами записи больше чем
максимальная длина предыдущих записей (в начале это условие равно
истине, поскольку переменная $maxlength в начале получает
значение 0), то мы устанавливаем максимальную длину записи равной длине
текущей записи, и запоминаем значение ключа в массиве самых длинных
ключей. Однако, следующие ключи, чьи значения имеют ту же длину будут
помещаться в конеч списка ключей.
Теперь в массиве @longest у нас находятся все числа,
которые имеют самое большое столкновений. Как получается, в стандартном
словаре /usr/dict/words имеется только по одному значению, но
давайте притворимся, что значений может быть много и рассмотрим
оставшийся код.
Теперь нам необходимо выдать данные:
for my $number (sort @longest) {
print
"$number: ",
join(" ", sort @{$num_to_words{$number}}),
"\n";
}
Для каждого из преобразованных чисел в массиве самых длинных списков, мы выдаем само число и затем список всех слов, которые соответствуют этому числу.
И когда мы поместим все куски кода вместе, у нас получится готовая программа:
use strict;
my %num_to_words;
@ARGV = "/usr/dict/words" unless @ARGV;
while (<>) {
chomp;
next unless
my $translate = translate($_);
push @{$num_to_words{$translate}}, $_;
}
my $maxlength = 0;
my @longest;
for my $number (keys %num_to_words) {
my $length = @{$num_to_words{$number}};
if ($length > $maxlength) {
$maxlength = $length;
@longest = $number;
} elsif ($length == $maxlength) {
push @longest, $number;
}
}
for my $number (sort @longest) {
print
"$number: ",
join(" ", sort @{$num_to_words{$number}}),
"\n";
}
sub translate {
local $_ = lc shift;
return unless
tr[abcdefghijklmnoprstuvwxy]
[222333444555666777888999]
== length;
$_;
}
И теперь вот ответ на оригинальную головоломку. Наибольшее
количество слов в /usr/dict/words, которые соответствуют одним
и тем же телефонным цифрам, имеется в одном списке, который состоит из
слов:
22737: acres bards barer bares baser bases caper capes cards cares cases
И больше нет фиктивных фраз! Встретимся в следующий раз, наслаждайтесь!