我怎样才能将几个哈希合并到Perl中的一个哈希中？ [英] How can I merge several hashes into one hash in Perl?

查看：100
本文介绍了我怎样才能将几个哈希合并到Perl中的一个哈希中？的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

在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']}}; b 
 
 
 
 
 
  $ 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']} 
]};


解决方案

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



这可以满足你想要的大部分。我没有把东西存储在单数
散列的数组中，因为我不觉得这是有用的。

您的场景不是常规场景。我试图在一定程度上对此进行泛化，
但是无法克服此代码的奇异性。


  • 首先，因为它看起来似乎要将具有相同
    id的所有内容合并为一个合并的实体例外），你必须通过结构
    下拉实体的定义。跟踪关卡，因为你
    希望它们以树的形式存在。接下来，组装ID表，尽可能合并实体。请注意，您
    已将995定义为一个空数组，另一个级别定义为空数组。所以给出
    的输出，我想用哈希覆盖空列表。

  • 之后，我们需要将根移动到结果结构中，按
    的顺序递减以将规范实体分配给每个级别的标识符。

    • 像我说的那样，这不是经常性的。当然，如果你仍然想要一个不超过两对的哈希列表
    ，这是一个留给你的练习。 

      use strict; 
    使用警告; 
     
    ＃子程序标识所有元素
     sub descend_identify {
     my（$ level，$ hash_ref）= @_; 
    ＃返回一个扩展列表，当我们删除
    返回地图{b $ b my $ item = $ hash_ref-> {$ _}; 
     $ _ => （$ level，$ item）
    ，（ref（$ item）eq'HASH'？descend_identify（$ level + 1，$ item）
    ：（）
    ）
    ; 
    }键％$ hash_ref 
    ; 
    } 
     
    ＃子程序重新构建所有嵌套元素
     sub descend_restore {
     my（$ hash，$ ident_hash）= @_; 
     
    我的@keys =键％$ hash; 
     @ $ hash {@keys} = @ $ ident_hash {@keys}; 
     foreach my $ h（grep {ref（）eq'HASH'} values％$ hash）{
     descend_restore（$ h，$ ident_hash）; 
    } 
     return; 
    } 
     
    ＃合并哈希，从而降低哈希结构。 
     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通过列表中的每一个散列级别
    ＃@hash_list被假定为你所有的Dumper-ed。 
     my @pairs = map {descend_identify（0，$ _）; } @hash_list; 
     
     while（@pairs）{
     my（$ key，$ level，$ ref）= splice（@pairs，0，3）; 
     $ levels {$ key} | = $ level; 
     
    ＃如果我们已经有了这个密钥的身份，那么合并这两个
     if（exists $ ident_map {$ key}）{
     my $ oref = $ ident_map {$ key }; 
     my $ otyp = ref（$ oref）; 
     if（$ otyp ne ref（$ ref））{
    ＃空数组可以被hashrefs覆盖 - 每995 
     if（$ otyp eq'ARRAY'&& $ oref == 0&& ref（$ ref）eq'HASH'）{
     $ ident_map {$ key} = $ ref; 
    } 
     else {
     die'$ key'！的不确定合并; 
     
     
     elsif（$ otyp eq'HASH'）{
     merge_hashes（$ oref，$ ref）; 
    } 
     else {
     @ $ oref = sort {$ a< => $ b || $ a cmp $ b}键％{{@ $ ref，@ $ oref}}; 
    } 
    } 
     else {
     $ ident_map {$ key} = $ ref; 
     
     
     
    ＃只复制没有出现在更高级别的键到
    ＃结果哈希值
     if（my @keys = grep {！$ levels {$ _}}键％ident_map）{
     @result {@keys} = @ident_map {@keys} if @keys; 
     
     
    ＃然后遍历散列以确保
    ＃所有级别的条目等于标识
     descend_restore（\％result，\\ \\％ident_map）;


    In Perl, how do I get this:

    $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' ] } };

    to this:

    $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' ] }
]};

    解决方案

    I think this is closer than anybody else has gotten:

    This does most of what you want. I did not store things in arrays of singular hashes, as I don't feel that that is useful.

    Your scenario is not a regular one. I've tried to genericize this to some extent, but was not possible to overcome the singularity of this code.

    • First of all because it appears you want to collapse everything with the same id into a merged entity (with exceptions), you have to descend through the structure pulling the definitions of the entities. Keeping track of levels, because you want them in the form of a tree.

    • Next, you assemble the ID table, merging entities as possible. Note that you had 995 defined as an empty array one place and as a level another. So given your output, I wanted to overwrite the empty list with the hash.

    • After that, we need to move the root to the result structure, descending that in order to assign canonical entities to the identifiers at each level.

    Like I said, it's not anything that regular. Of course, if you still want a list of hashes which are no more than pairs, that's an exercise left to you. 

    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中的一个哈希中？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！

查看全文
相关文章
其他开发最新文章
热门教程
热门工具
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆