如何遞歸地分配perl多維散列鍵的值，其中該鍵與嵌套鍵的值相似？

Question

假設我的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類似於嵌套關鍵test{'4'}的x的價值。我想要的是用具有與嵌套鍵的值相匹配的特定散列來替換那些嵌套鍵的值。 這樣，例如，test{'4'}看起來像由test{'3'}和test{'2'}鍵

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

所以哈希更換後，我該怎麼做，使用遞歸函數/子程序時，我有一個大而深的哈希？

對不起，如果這個查詢是重複的。無論如何，我試過但沒有找到我滿意的答案。

感謝極客。

Answer 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; 

Answer 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);