[предполагаемый заголовок: В чем отличие?]
Часть общих задач программирования связана с изменяющимися вещами. И вещи на самом деле изменяются, и нам нужно знать как они изменяются.
Hапример, если у нас есть список данных:
@one = qw(a b c d e f g);
и позднее, мы глянем на него снова, мы увидим отличный набор данных:
@two = qw(b c e h i j);
Как мы можем определить что здесь новое, что старое и что удалено?
Мы могли бы сделать это применяя грубую силу:
@one = qw(a b c d e f g);
@two = qw(b c e h i j);
foreach $one (@one) {
if (grep $one eq $_, @two) {
print "$one находится в обоих списках\n";
} else {
print "$one был удален\n";
}
}
foreach $two (@two) {
unless (grep $two eq $_, @one) {
print "$two был добавлен\n";
}
}
И это действительно дает нам соответствующий ответ:
a был удален b находится в обоих списках c находится в обоих списках d был удален e находится в обоих списках f был удален g был удален h был добавлен i был добавлен j был добавлен
Hо это невероятно неэффективно. Время вычисления будет расти в пропорции
произведению размеров обоих списков. Это происходит поскольку каждый элемент
первого списка сравнивается с каждым из элементов другого списка (в
действительности это происходит дважды). Оператор grep проходит по каждому из
элементов, так что мы получаем эффективные вложенные циклы и это почти
всегда должно быть знаком опасности.
Справочная страница perlfaq4 предлагает подход к данной
задаче, давая примерно следующее решение:
@union = @intersection = @difference = ();
%count = ();
foreach $element (@one, @two) { $count{$element}++ }
foreach $element (keys %count) {
push @union, $element;
push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
}
с предупреждением, что мы предполагаем что каждый из элементов списка встречается только один раз внутри каждого из списков. Хотя это работает с нашими данными, но мы встретимся с проблемами при работе с более общими данными. Однако, немного изменив программу мы сможем обрабатывать даже дублирующиеся элементы в каждом из списков:
@one = qw(a a a a b c d e f g);
@two = qw(b c e h i i i i j);
my %tracker = ();
$tracker{$_} .= 1 for @one;
$tracker{$_} .= 2 for @two;
for (sort keys %tracker) {
if ($tracker{$_} !~ /1/) {
print "$_ has been added\n";
} elsif ($tracker{$_} !~ /2/) {
print "$_ has been deleted\n";
} else {
print "$_ is in both old and new\n";
}
}
Удача. Правильный вывод и достаточно эффективно. Если вы выполняете
много подобных действий, то посмотрите на CPAN модули, чьи имена
начинаются с Set::.
И мы приходим к проблеме о разнице между двумя последовательностями, в
которых важен порядок следования. Великолепный модуль
Algorithm::Diff имеющийся на CPAN вычисляет разумно короткий
список отличий, аналогично команде diff из поставки Unix, которые
описывает как преобразовать один список в другой. Существует несколько
интерфейсов. Hаиболее интересным я нашел traverse_sequences,
который последовательно дает мне все элементы обоих списков, но помечает их
так, что я могу сказать к какому из списков (или к обоим) относится этот
элемент.
Давайте взглянем на простой пример:
use Algorithm::Diff qw(traverse_sequences);
@one = qw(M N a b P Q c d e f V W g h);
@two = qw(a b R S c d T U e f g h X Y);
traverse_sequences(\@one, \@two, {
MATCH => sub { show($one[$_[0]], $two[$_[1]]) },
DISCARD_A => sub { show($one[$_[0]], "---") },
DISCARD_B => sub { show("---", $two[$_[1]]) },
});
sub show {
printf "%10s %10s\n", @_;
}
Здесь имеется две заданные последовательности, хранящиеся в списках
@one и @two. Используя функцию
traverse_sequences, мы будем выдавать общие элементы
последовательностей (используя правило MATCH), удаленные элементы
(используя правило DISCARD_A), и новые элементы (используя
правило DISCARD_B). Измененные данные отображаются как серии
удалений, за которыми следуют серии вставок.
Правила (callbacks) определяются как ссылки на анонимный процедуры,
более известные как ``coderefs''. Каждому из правил передается два
параметра -- текущие индексы внутри массивов @one и
@two. Поскольку это не значения, я должен взять индексы и
заглянуть в соответствующий массив.
Результат выполнения выглядит следующим образом:
M ---
N ---
a a
b b
P ---
Q ---
--- R
--- S
c c
d d
--- T
--- U
e e
f f
V ---
W ---
g g
h h
--- X
--- Y
Заметьте общие последовательности элементов. Оператор printf
красиво форматирует колонки.
Текстовый поколоночный вывод это хорошо, но мы можем получить более красивое оформление, если мы будем делать вывод в формате HTML. Давайте раскрасим все удаления красным, а все вставки зеленым.
Hа первый взгляд, этот алгоритм генерирует слишком много тагов
font:
use Algorithm::Diff qw(traverse_sequences);
@one = qw(M N a b P Q c d e f V W g h);
@two = qw(a b R S c d T U e f g h X Y);
traverse_sequences(\@one, \@two, {
MATCH => sub { colorshow("", $one[$_[0]]) },
DISCARD_A => sub { colorshow("red", $one[$_[0]]) },
DISCARD_B => sub { colorshow("green", $two[$_[1]]) },
});
sub colorshow {
my $color = shift;
my $string = shift;
if (length $color) {
print "<font color=$color>$string</font>\n";
} else {
print "$string\n";
}
}
Этот код генерирует корректный результат, но при этом вывод становится чрезвычайно избыточным: <font color=red>M</font> <font color=red>N</font> a b <font color=red>P</font> <font color=red>Q</font> <font color=green>R</font> <font color=green>/font c d <font color=green>T</font> <font color=green>U</font> e f <font color=red>V</font> <font color=red>W</font> g h <font color=green>X</font> <font color=green>Y</font>
Все что нам надо -- это отслеживание информации о состоянии для отслеживания того, в режиме какого цвета мы находимся:
use Algorithm::Diff qw(traverse_sequences);
@one = qw(M N a b P Q c d e f V W g h);
@two = qw(a b R S c d T U e f g h X Y);
traverse_sequences(\@one, \@two, {
MATCH => sub { colorshow("", $one[$_[0]]) },
DISCARD_A => sub { colorshow("red", $one[$_[0]]) },
DISCARD_B => sub { colorshow("green", $two[$_[1]]) },
});
colorshow(""); # reset back to
BEGIN {
my $currentcolor = "";
sub colorshow {
my $color = shift;
my $string = shift;
if ($color ne $currentcolor) {
print "</font>\n" if length $currentcolor;
print "<font color=$color>\n" if length $color;
$currentcolor = $color;
}
if (defined $string and length $string) {
print "$string\n";
}
}
}
Здеся я отслеживаю состояние текущего цвета HTML с помощью статической
переменной $currentcolor. При ее изменении я посылаю
соответствующие таги окончания и начала тага font. Единственным
неудобством является то, что нам необходимо выполнить заключительный вызов
colorshow с бесцветным тагом для закрытия существующего начального
тага. Этот вызов является безвредным если мы находимся снаружи
раскрашенного региона.
И это намного лучше, давая следующий результат:
<font color=red>
M
N
</font>
a
b
<font color=red>
P
Q
</font>
<font color=green>
R
S
</font>
c
d
<font color=green>
T
U
</font>
e
f
<font color=red>
V
W
</font>
g
h
<font color=green>
X
Y
</font>
Хотя мои друзья-знатоки web могут предпочитать видеть это в таком виде:
<span style="background: red; color: black">
M
N
</span>
a
b
<span style="background: red; color: black">
P
Q
</span>
<span style="background: green; color: black">
R
S
</span>
c
d
<span style="background: green; color: black">
T
U
</span>
e
f
<span style="background: red; color: black">
V
W
</span>
g
h
<span style="background: green; color: black">
X
Y
</span>
Это совсем маленькое изменение, но я оставляю его для вам. Hемного маловато пробельных символов, до того стиля, который я люблю, но по крайней мере работа выполняется с небольшими трудозатратами.
Так, что теперь, когда кто-нибудь спросит вас ``в чем отличие?'', вы можете продемонстрировать различные способы ответа на этот вопрос. До следующей встречи, наслаждайтесь!