Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Perl: Общие вопросы > Подсчет равных хеш-таблиц

Автор: Danissimo 6.2.2007, 01:59

Постановка задачи:

Дано множество хеш-таблиц L = { h(i) }, где h(i) -- i-тый элемент или, другими словами, i-тая хеш-таблица.
Для h(i) задано множество ее ключей K(i) = { k(i, 0), k(i, 1), ... }. Множества ключей могут пересекаться, а могут и нет, то есть

K(i) * K(j) = ?, i != j.

Значениями ключей таблицы h(i) является множество V(i) = { v(i, 0), v(i, 1), ... }, такое, что k(i, 0) => v(i, k(i, 0)), k(i, 1) => v(i, k(i, 1)), ...

(Я знаю, что вы все это знаете. Мне нужно подойти к заданию.)

Табицы h(i) и h(j) считаются равными, если для пересечения множества ключей R = K(i) * K(j) = { r(0), r(1), ... }, значения ключей из полученного множества равны:

v(i, r(0)) == v(j, r(0)) и
v(i, r(1)) == v(j, r(1)), и
v(i, r(2)) == v(j, r(2)), и т. д.

Напрмер, если

K(i) = { k(i, a), k(i, b), k(i, x), k(i, y) },
K(j) = { k(j, c), k(j, b), k(j, x), k(j, z) },
R = K(i) * K(j) = { r(b), r(x) },

то h(i) == h(j), если v(i, r(b)) == v(j, r(b)) и v(i, r(x)) == v(j, r(x)).

Множество L считать упорядоченым (то есть списком; не путать с отсортированным). Для определенности обход начинать с начала списка.

Необходимо удалить из L все h(j), для которых h(i) == h(j), i < j, добавляя к h(i) ключ c(i), значение которого равно количеству хеш-таблиц h(j), равных h(i). Если h(i) == h(j) и h(k) == h(j), где i < j < k, то счетчик совпадений увеличивать для h(i), но для h(k).

Задача не детерминирована, так как в зависимости от того, как пересекаются множества ключей таблиц, а также в зависимости от их упорядоченности в начале обхода, можно получить разные результаты.

Можно детерминировать задачу, если ввести ограничение, позволяющее всем хеш-таблицам иметь одно и то же множество ключей R.

Теперь про решение ;)

Я смог решить детерминированную (!) задачу (в которой у всех таблиц множества ключей одинаковые) лишь вложенными циклами:

Код


my @L = (
    { a => 'a',   b => 'b', c => undef },
    { a => 'a',   b => 'b', c => 'c' },
    { a => undef, b => 'b', c => 'c' },
    { a => 'a',   b => 'b', c => 'c' },
    { a => 'a',   b => 'b', c => 'c' },
    { a => 'a',   b => 'b', c => undef }
);
my @R = qw(a b c);

foreach my $i (0..$#L) {
    next if !$L[$i];
    my %hi = %{$L[$i]};
    my $cnt = 1;
    foreach my $j ($i + 1..$#L) {
        next if !$L[$j];
        my %hj = %{$L[$j]};
        my $notEqual = 0;
        foreach (@R) {
            unless ((!defined $hi{$_} and !defined $hj{$_})
                or (defined $hi{$_} and defined $hj{$_} and $hi{$_} eq $hj{$_})) {
                $notEqual = 1;
                last;
            }
        }
        unless ($notEqual) {
            $cnt += 1;
            delete $L[$j];
        }
    }
    $L[$i]->{cnt} = $cnt;
}

foreach (@L) {
    next if !$_;
    my %x = %$_;
    print join(', ', map { "$_ => " . ($x{$_} || 'false') } keys %x) . "\n";
}

И это работает ну очень медленно. Я уже не говорю про общую задачу.

Можете ли предложить более элегантное решение?

Автор: JAPH 6.2.2007, 11:26

Приведу моё решение. Насчёт скорости - не знаю, максимальный уровень вложенности циклов 3.

Код


use strict; use warnings;    
my @L = ({ a => 'a',   b => 'b', c => undef },    
         { a => 'a',   b => 'b', c => 'c' },    
         { a => undef, b => 'b', c => 'c' },    
         { a => 'a',   b => 'b', c => 'c' },    
         { a => 'a',   b => 'b', c => 'c' },    
         { a => 'a',   b => 'b', c => undef });    
my @Q = ();    
while (my $l = @L) {    
    my $L = shift @L;    
    @L = grep { notequal($_, $L) } @L;    
    push @Q, { %$L, 'count' => $l - @L }    
}    
foreach my $Q(@Q) {    
    print join(', ', map { $_ . ' => ' . (defined $$Q{$_} ? $$Q{$_} : 'undef') } keys %$Q ) . "\n"    
}    
sub notequal {    
    no warnings;    
    $_[0]{$_} ne $_[1]{$_} ? return 1 : 1 foreach grep { exists $_[1]{$_} } keys %{$_[0]};    
    return 0    
}

Автор: Danissimo 6.2.2007, 21:26

Класс!!! Мало того, что понятнее, красивее, так еще на 50% быстрее. Отличный результат. Спасибо =)

Добавлено @ 21:27
Смотри-ка какие классные программеры во Всеволожске обитают =)

Автор: tishaishii 13.2.2007, 00:16

Быстрее:

Код

sub notequal {
    no warnings;
    +grep {exists $_[1]{$_} && $_[0]{$_} ne $_[1]{$_}} keys %{$_[0]}
}
my @L = ({ a => 'a',   b => 'b', c => undef },
         { a => 'a',   b => 'b', c => 'c' },
         { a => undef, b => 'b', c => 'c' },
         { a => 'a',   b => 'b', c => 'c' },
         { a => 'a',   b => 'b', c => 'c' },
         { a => 'a',   b => 'b', c => undef });
my(@Q, $L, $l);
while ($l=@L) {
    $L=shift @L;
    @L=grep{notequal($_, $L) }@L;
    push @Q, {%$L, 'count' =>$l-@L}
}
print join(', ', map { $_ . ' => ' . (defined $$_{$_} ? $$_{$_} : 'undef') } keys %$_ ) . "\n" foreach @Q;