如何递归地分配 perl 多维哈希的键的值，其中该键类似于嵌套键的值？

Posted 2023-04-14

【中文标题】如何递归地分配 perl 多维哈希的键的值，其中该键类似于嵌套键的值？

【英文标题】：How to recursively assign values of a key of a perl multi-dimensional hash where that key is similar to value of a nested key?

【发布时间】：2014-10-29 22:07:03

【问题描述】：

假设我的 Perl 多维散列是

my %test;
$test'1' =   'x'=>0, 'y'=>0 ;
$test'2' =   'x'=>1, 'y'=>0 ;
$test'3' =   'x'=>1, 'y'=>2 ;
$test'4' =   'x'=>3, 'y'=>2 ;

这里，键 3 类似于嵌套键 x 的值 test'4'。我想要的只是用与嵌套键的值匹配的特定哈希替换那些嵌套键的值。 这样，例如，test'4' 在替换为 test'3' 和 test'2' 键的哈希后的样子

$test'4'= 'x'=> 'x'=>1,'y'=>2 'y'=>  'x'=> 1,'y'=> 0 

那么，当我有一个大的深度散列时，我该如何使用递归函数/子例程呢？

抱歉，如果此查询重复。无论如何，我尝试了但没有找到满意的答案。

感谢极客。

【参考方案1】：

您的问题定义远未完成，但这应该接近您的需求：

use strict;
use Data::Dumper;

sub self_substitute 

  my $h = shift;

  my $help; $help = sub 
    my $val = shift;
    if (ref $val eq "HASH") 
      my $new_val = ;
      while ( my ($hash_key, $hash_val) = each %$val ) 
        $new_val->$hash_key = $help->($hash_val);
      
      $new_val
    
    else 
      exists $h->$val ? $h->$val : $val
    
  ;

  $help->($h);


sub main 

  my %test;
  $test'1' =   'x'=>0, 'y'=>0 ;
  $test'2' =   'x'=>1, 'y'=>0 ;
  $test'3' =   'x'=>1, 'y'=>2 ;
  $test'4' =   'x'=>3, 'y'=>2 ;

  my $result = self_substitute(\%test);
  print Dumper($result)


main;

【讨论】：

抱歉我的误导性问题。但是，我认为你和我的想法非常接近。再次感谢哥们！

【参考方案2】：

你可能想要这样的东西：

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

my %test = ( 
    1 =>   'x'=>0, 'y'=>0 ,
    2 =>   'x'=>1, 'y'=>0 ,
    3 =>   'x'=>1, 'y'=>2 ,
    4 =>   'x'=>3, 'y'=>2 ,
    );

my $result = makeNext(\%test, \%test);
print Dumper($result)."\n";

sub makeNext 
    my ( $orig, $obj ) = @_;
    if ( ref($obj) eq 'HASH' ) 
        return  map  $_, makeNext($orig, $obj->$_)  keys %$obj ;
    
    elsif ( exists($orig->$obj) ) 
        return makeNext($orig, $orig->$obj)
    
    else 
        return $obj;
    

如果您只关心打印结果，您可以一次性完成。 这只是在任何地方都引用了正确的东西，所以深印可以正常工作，但操作会出现问题。

my %test = ( 
    1 =>   'x'=>0, 'y'=>0 ,
    2 =>   'x'=>1, 'y'=>0 ,
    3 =>   'x'=>1, 'y'=>2 ,
    4 =>   'x'=>3, 'y'=>2 ,
    );

foreach my $index (keys %test) 
    foreach my $key (keys %$test$index) 
        $test$index$key = $test$test$index$key if exists($test$test$index$key);
    

$Data::Dumper::Deepcopy = 1;
print Dumper(\%test);

【讨论】：

是的，谢谢。你在这里向我展示了整个包裹。这很酷。我想我的问题在这里解决了。