如何将多个哈希值合并到Perl中的一个哈希中？

Question

在Perl中,我该如何获得:

$VAR1 = { '999' => { '998' => [ '908', '906', '0', '998', '907' ] } }; 
$VAR1 = { '999' => { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] } }; 
$VAR1 = { '999' => { '996' => [] } }; 
$VAR1 = { '999' => { '995' => [] } }; 
$VAR1 = { '999' => { '994' => [] } }; 
$VAR1 = { '999' => { '993' => [] } }; 
$VAR1 = { '999' => { '997' => [ '986', '987', '990', '984', '989', '988' ] } }; 
$VAR1 = { '995' => { '101' => [] } }; 
$VAR1 = { '995' => { '102' => [] } }; 
$VAR1 = { '995' => { '103' => [] } }; 
$VAR1 = { '995' => { '104' => [] } }; 
$VAR1 = { '995' => { '105' => [] } }; 
$VAR1 = { '995' => { '106' => [] } }; 
$VAR1 = { '995' => { '107' => [] } }; 
$VAR1 = { '994' => { '910' => [] } }; 
$VAR1 = { '993' => { '909' => [] } }; 
$VAR1 = { '993' => { '904' => [] } }; 
$VAR1 = { '994' => { '985' => [] } }; 
$VAR1 = { '994' => { '983' => [] } }; 
$VAR1 = { '993' => { '902' => [] } }; 
$VAR1 = { '999' => { '992' => [ '905' ] } }; 

对此:

$VAR1 = { '999:' => [
 { '992' => [ '905' ] },
 { '993' => [
  { '909' => [] },
  { '904' => [] },
  { '902' => [] }
 ] },
 { '994' => [
  { '910' => [] },
  { '985' => [] },
  { '983' => [] }
 ] },
 { '995' => [
  { '101' => [] },
  { '102' => [] },
  { '103' => [] },
  { '104' => [] },
  { '105' => [] },
  { '106' => [] },
  { '107' => [] }
 ] },
 { '996' => [] },
 { '997' => [ '986', '987', '990', '984', '989', '988' ] },
 { '998' => [ '908', '906', '0', '998', '907' ] },
 { '991' => [ '913', '920', '918', '998', '916', '919', '917', '915', '912', '914' ] }
]};

Answer 1

我认为这比其他任何人都更接近：

这可以满足您的大部分需求。我没有将东西存储在单一散列数组中，因为我认为这没有用。

您的场景不是常规场景。我试图在某种程度上概括这一点，但不可能克服这段代码的奇异性。

• 首先，因为您似乎想要将具有相同 id 的所有内容折叠到一个合并实体中（有例外），所以您必须深入了解拉动实体定义的结构。跟踪级别，因为您希望它们采用树的形式。

• 接下来，您将组装 ID 表，并尽可能合并实体。请注意，您在一个地方将 995 定义为空数组，在另一个地方定义为级别。因此，鉴于您的输出，我想用哈希覆盖空列表。

• 之后，我们需要将根移动到结果结构，并对其进行降序排列，以便将规范实体分配给每个级别的标识符。

就像我说的，这不是什么常规的事情。当然，如果您仍然想要一个不超过对的哈希列表，那么这就是留给您的练习。

use strict;
use warnings;

# subroutine to identify all elements
sub descend_identify {
    my ( $level, $hash_ref ) = @_;
    # return an expanding list that gets populated as we desecend 
    return map {
        my $item = $hash_ref->{$_};
        $_ => ( $level, $item )
            , ( ref( $item ) eq 'HASH' ? descend_identify( $level + 1, $item ) 
              :                          ()
              )
           ;
    } keys %$hash_ref
    ;
}

# subroutine to refit all nested elements
sub descend_restore { 
    my ( $hash, $ident_hash ) = @_;

    my @keys        = keys %$hash;
    @$hash{ @keys } = @$ident_hash{ @keys };
    foreach my $h ( grep { ref() eq 'HASH' } values %$hash ) {
        descend_restore( $h, $ident_hash );
    }
    return;
}

# merge hashes, descending down the hash structures.
sub merge_hashes {
    my ( $dest_hash, $src_hash ) = @_;
    foreach my $key ( keys %$src_hash ) {
        if ( exists $dest_hash->{$key} ) {
            my $ref = $dest_hash->{$key};
            my $typ = ref( $ref );
            if ( $typ eq 'HASH' ) {
                merge_hashes( $ref, $src_hash->{$key} );
            }
            else { 
                push @$ref, $src_hash->{$key};
            }
        }
        else {
            $dest_hash->{$key} = $src_hash->{$key};
        }
    }
    return;
}

my ( %levels, %ident_map, %result );

#descend through every level of hash in the list
# @hash_list is assumed to be whatever you Dumper-ed.
my @pairs = map { descend_identify( 0, $_ ); } @hash_list;

while ( @pairs ) {
    my ( $key, $level, $ref ) = splice( @pairs, 0, 3 );
    $levels{$key} |= $level;

    # if we already have an identity for this key, merge the two
    if ( exists $ident_map{$key} ) {
        my $oref = $ident_map{$key};
        my $otyp = ref( $oref );
        if ( $otyp ne ref( $ref )) {
            # empty arrays can be overwritten by hashrefs -- per 995
            if ( $otyp eq 'ARRAY' && @$oref == 0 && ref( $ref ) eq 'HASH' ) {
                $ident_map{$key} = $ref;
            }
            else { 
                die "Uncertain merge for '$key'!";
            }
        }
        elsif ( $otyp eq 'HASH' ) {
            merge_hashes( $oref, $ref );
        }
        else {
            @$oref = sort { $a <=> $b || $a cmp $b } keys %{{ @$ref, @$oref }};
        }
    }
    else {
        $ident_map{$key} = $ref;
    }
}

# Copy only the keys that do not appear at higher levels to the 
# result hash
if ( my @keys = grep { !$levels{$_} } keys %ident_map ) { 
    @result{ @keys } = @ident_map{ @keys } if @keys;

}
# then step through the hash to make sure that the entries at
# all levels are equal to the identity
descend_restore( \%result, \%ident_map );