如何在perl中分解數組哈希中的常見元素？

Question

我試圖在Perl中的數組散列中找到元素的任何交叉點

例如

my %test = (
                  Lot1 => [ "A","B","C"],
                  Lot2 => [ "A","B","C"],
                  Lot3 => ["C"],
                  Lot4 => ["E","F"],
            );

我想要的結果是

• Lot1和Lot2有AB

• Lot1，Lot2和Lot3都有C.

• Lot4有E和F.

我認為這可以通過遞歸函數來完成，該函數有效地移動通過數組，如果找到兩個數組之間的交集，則會通過找到的交集和下一個數組遞歸調用自身。 停止條件將耗盡陣列。

退出函數后，我將不得不遍歷散列以獲取包含這些值的數組。

這聽起來像是一個好方法嗎？ 我一直在努力使用代碼，但是我將使用List :: Compare來確定交集。

謝謝。

Answer 1

Array::Utils有一個交集操作，您可以在其中測試兩個數組的交叉。 但這只是你要做的事情的起點。

所以我認為你需要先反轉你的查找：

my %member_of;

foreach my $key ( keys %test ) { 
    foreach my $element  ( @{$test{$key}} ) { 
         push ( @{$member_of{$element}}, $key ); 
    }
}
print Dumper \%member_of;

贈送：

$VAR1 = {
          'A' => [
                   'Lot1',
                   'Lot2'
                 ],
          'F' => [
                   'Lot4'
                 ],
          'B' => [
                   'Lot1',
                   'Lot2'
                 ],
          'E' => [
                   'Lot4'
                 ],
          'C' => [
                   'Lot1',
                   'Lot2',
                   'Lot3'
                 ]
        };

然后把它折疊成一個關鍵集：

my %new_set;
foreach my $element ( keys %member_of ) {
    my $set = join( ",", @{ $member_of{$element} } );
    push( @{ $new_set{$set} }, $element );
}
print Dumper \%new_set;

贈送：

$VAR1 = {
          'Lot1,Lot2,Lot3' => [
                                'C'
                              ],
          'Lot1,Lot2' => [
                           'A',
                           'B'
                         ],
          'Lot4' => [
                      'E',
                      'F'
                    ]
        };

整體而言：

#!/usr/bin/env perl

use strict;
use warnings;
use Data::Dumper;

my %test = (
    Lot1 => [ "A", "B", "C" ],
    Lot2 => [ "A", "B", "C" ],
    Lot3 => ["C"],
    Lot4 => [ "E", "F" ],
);

my %member_of;
foreach my $key ( sort keys %test ) {
    foreach my $element ( @{ $test{$key} } ) {
        push( @{ $member_of{$element} }, $key );
    }
}

my %new_set;
foreach my $element ( sort keys %member_of ) {
    my $set = join( ",", @{ $member_of{$element} } );
    push( @{ $new_set{$set} }, $element );
}

foreach my $set ( sort keys %new_set ) {
    print "$set contains: ", join( ",", @{ $new_set{$set} } ), "\n";
}

我不認為有更有效的方法來處理它，因為你將每個數組與每個其他數組進行比較，並從中形成一個新的復合鍵。

這給你：

Lot1,Lot2 contains: A,B
Lot1,Lot2,Lot3 contains: C
Lot4 contains: E,F

Answer 2

這可以通過兩個簡單的哈希轉換來完成：

• 構建一個哈希，列出每個項目所在的所有批次

• 將其轉換為列出每個批次組合的所有項目的哈希

然后以方便的形式轉儲最后一個哈希

這是代碼。

use strict;
use warnings 'all';
use feature 'say';

my %test = (
    Lot1 => [ "A", "B", "C" ],
    Lot2 => [ "A", "B", "C" ],
    Lot3 => ["C"],
    Lot4 => [ "E", "F" ],
);

my %items;

for my $lot ( keys %test ) {
    for my $item ( @{ $test{$lot} } ) {
        push @{ $items{$item} }, $lot;
    }
}

my %lots;

for my $item ( keys %items ) {
    my $lots = join '!', sort @{ $items{$item} };
    push @{ $lots{$lots} }, $item;
}

for my $lots ( sort keys %lots ) {

    my @lots = split /!/, $lots;
    my $items = join '', @{ $lots{$lots} };

    $lots = join ', ', @lots;
    $lots =~ s/.*\K,/ and/;

    printf "%s %s %s\n", $lots, @lots > 1 ? 'have' : 'has', $items;
}

產量

Lot1 and Lot2 have AB
Lot1, Lot2 and Lot3 have C
Lot4 has EF

它生成一個看起來像這樣的%items哈希

{
  A => ["Lot2", "Lot1"],
  B => ["Lot2", "Lot1"],
  C => ["Lot2", "Lot3", "Lot1"],
  E => ["Lot4"],
  F => ["Lot4"],
}

並從那里看起來像這樣的%lots哈希

{
  "Lot1!Lot2" => ["A", "B"],
  "Lot1!Lot2!Lot3" => ["C"],
  "Lot4" => ["E", "F"],
}