作者热门文章
- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
在 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' ] }
]};
最佳答案
我认为这比其他任何人都更接近:
这可以满足您的大部分需求。我没有将东西存储在单数数组中
散列,因为我觉得这没什么用。
您的场景不是常规场景。我试图在某种程度上概括这一点,
但无法克服此代码的奇异性。
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 );
关于perl - 如何在 Perl 中将多个哈希合并为一个哈希?,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/2767477/
我是一名优秀的程序员,十分优秀!