如何扩展一个数组的哈希？

Question

我不确定“扩展”是否是正确的词，但这是我想做的事情 =)

这个脚本

#!/usr/bin/perl

use warnings; 
use strict;

my %HoA = (
    group1 => [ "user1", "user2" ],
    group2 => [ "group1", "user3" ],
    group3 => [ "group1", "group2" ],
    group4 => [ "group3", "user2" ],
    );

foreach my $group ( keys %HoA ) {
    print "$group: @{ $HoA{$group} }\n"
}

输出

group1: user1 user2
group2: group1 user3
group3: group1 group2
group4: group3 user4

我希望的是将数组中的组替换为其成员。也就是说，输出和$HoA应该变成：

group1: user1 user2
group2: user1 user2 user3
group3: user1 user2 user3
group4: user1 user2 user3 user4

也许“查找和替换”并删除重复项更能解释我想做的事情？

- Sandra Schlichting

---

如果存在循环引用怎么办？例如，如果group1有group2，而group2又有group1呢？ - CanSpice

然后我想要发送该组，并打印一个错误。 - Sandra Schlichting

Answer 1

假设您提供的数据，以下循环将使用扩展数组创建新的哈希表。该算法假定组将按排序顺序解决（group2仅依赖于group1，group3依赖于1/2，...）。

my %expanded;
for my $group (sort keys %HoA) {
    my %seen;
    $expanded{$group} = [
        grep {not $seen{$_}++}
        map {exists $expanded{$_} ? @{$expanded{$_}} : $_}
        @{$HoA{$group}}
    ];
    print "$group: @{ $expanded{$group} }\n"
}

打印结果如下：

group1: 用户1 用户2
group2: 用户1 用户2 用户3
group3: 用户1 用户2 用户3
group4: 用户1 用户2 用户3

如果不能假设有一个解决方案的顺序，以下方法可能相对粗暴，但应该能够发挥作用：

my %HoA = (
    group1 => [ "user1", "user2" ],
    group2 => [ "group1", "user3" ],
    group3 => [ "group1", "group2" ],
    group4 => [ "user5", "group5" ],
    group5 => [ "group3", "user2" ],
    );

my @to_expand = keys %HoA;

my %final;
my $tries = @to_expand;
to_expand: while (@to_expand and $tries) {
    my $next = shift @to_expand;

    my (@users, @groups);
    for (@{ $HoA{$next} }) {
        if (/^group/) {
            push @groups, $_;
        } else {
            push @users, $_;
        }
    }
    for my $group (@groups) {
        if (exists $final{$group}) {
            push @users, @{$final{$group}}
        } else {
            $tries--;
            push @to_expand, $next;
            next to_expand;
        }
    }
    $tries++;
    my %seen;
    $final{$next} = [grep {not $seen{$_}++} @users];
}
if (@to_expand) {
    print "error with groups: @to_expand\n";
}

for (sort keys %final) {
    print "$_: @{$final{$_}}\n";
}

该程序会输出以下内容：

group1: user1 user2
group2: user3 user1 user2
group3: user1 user2 user3
group4: user5 user2 user1 user3
group5: user2 user1 user3

如果程序出现错误（例如group3依赖于group5），则会输出以下内容：

error with groups: group4 group5 group3
group1: user1 user2
group2: user3 user1 user2

可能还有更好的算法能够实现这个功能。

- Eric Strom

---

很遗憾，我不能做出那样的假设 =( 这些组可以以任何组合方式相互包含。不过，这个脚本仍然非常令人印象深刻！ - Sandra Schlichting

我理解这行代码直到 for my $group (@groups) {。你能解释一下 $tries 的用途吗？还有 %seen 是如何工作的？ - Sandra Schlichting

@Sandra => $tries 是一个计数器，类似于 leonbloy 的答案中的 $cont 和 Axeman 的 $deep。它的作用是防止这些算法在面对循环或无法解决的依赖关系时进入无限循环（或深度递归）。 %seen 背后的想法是保持已添加用户的 O(1) 查找表。对于每个用户，都会查询此表，如果该用户尚未被查看，则将其添加到最终列表中。 - Eric Strom

Answer 2

如果存在递归，这将抛出一个错误 - 虽然不是完美的解决方案，但也不够优雅。

use strict;

my %HoA = (
    group1 => [ "user1", "user2" ],
    group2 => [ "group1", "user3" ],
    group3 => [ "group1", "group2" ],
    group4 => [ "group3", "user2" ],
    );

my %ex=(); # expanded hash

foreach my $g ( keys %HoA ) { # first population
     $ex{$g} = {};
     AddArrayToHash($ex{$g},$HoA{$g});
}
my $goon = 1;
my $cont =0;
while($goon) { # iterate
    $goon=0;
    die "too many iterations RECURSIVE DEFINITION?" if($cont++ >10) ;
    foreach my $g ( keys %ex ) {
        foreach my $u ( keys %{$ex{$g}} ) {
            if($ex{$u}) {
                delete $ex{$g}->{$u};
                AddArrayToHash($ex{$g},[ keys %{$ex{$u}}] );
                $goon = 1;
            }
        }
    }
}

foreach my $group ( sort keys %ex ) {
    print "$group: " . join(" ",sort  keys %{$ex{$group}}) ."\n";
}

sub AddArrayToHash {
    my($refhash,$refarray)=@_;
    foreach my $e (@$refarray) {
        $refhash->{$e} = 1;
    }
}

- leonbloy

Answer 3

我不知道为什么人们非得写那么多代码：

sub expand_group { 
    my ( $ref, $arref, $deep ) = @_;
    croak 'Deep Recursion!' if ++$deep > scalar( keys %$ref );
    return map { 
        exists $ref->{$_} ? expand_group( $ref, $ref->{$_}, $deep ) : $_ 
    } @$arref
    ;
}

sub expand_groups { 
    my ( $block, $group_ref ) = @_;
    while ( my ( $key, $val ) = each %$group_ref ) {
        $block->( $key, expand_group( $group_ref, $val, 1 ));
    }
}

expand_groups( sub { say join( ' ', @_ ); }, \%HoA );

- Axeman

---

除非你想这样调用 expand_groups { say join ' ', @_ } %HoA，否则不需要 &% 原型。 - friedo

Answer 4

我会尝试这样做。

#!/usr/bin/perl

use warnings; 
use strict;

my %HoA = (
    group1 => [ "user1", "user2" ],
    group2 => [ "group1", "user3" ],
    group3 => [ "group1", "group2" ],
    group4 => [ "group3", "user2" ],
    );


my %users; 

foreach my $group ( sort keys %HoA ) {
  %users = ();

  print "$group: ";
  print_key($group, $HoA{$group});
  print join " ", sort keys %users;
  print "\n";
}

sub print_key {
  my $group = shift;

  foreach my $item (@{$HoA{$group}}) {
    if (exists $HoA{$item}) {
       print_key($item);
    }
    else {
       $users{$item}++;
    }
  }
}

- René Nyffenegger