Mahboob
Mahboob

Reputation: 33

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?

Suppose my Perl multi-dimensional hash is

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

Here, the key 3 is similar to value of a nested key x of test{'4'}. All I want is to replace value of those nested keys with particular hashes which matches the values of the nested keys. Such that, for example, test{'4'} will look like after replacing by hash of test{'3'} and test{'2'} keys

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

So, how do I do that using a recursive function/subroutine when I have a large deep hash?

Sorry if this query is a duplicate. I tried but didn't find my satisfactory answer, anyways.

Thanks geeks.

Upvotes: 0

Views: 427

Answers (2)

marneborn
marneborn

Reputation: 699

You probably want something like this:

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

If all you care about is printing the result, you can do it in one pass. This just puts a reference to the correct thing everywhere, so the deep print works fine, but manipulating would be problematic.

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

Upvotes: 0

Gene
Gene

Reputation: 47020

Your problem definition is far from complete, but this ought to be close to what you need:

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;

Upvotes: 0

Related Questions