use strict; use warnings; use YAML; my $hIn= { (4,-1), (2,6), (6,4), (3,5), (5,-1), (99,-1), }; my $hOut = {}; #keep track of the one and only path to each number #except -1. my %hPaths; while (my ($k,$v) = each(%$hIn)) { # have we already found the path to $v # and if so do we have more than one path? my $aPath = $hPaths{$v}; if ($aPath) { #value was already found - either warn about two paths #or patch its path so it starts with the key unless ($#$aPath == 0) { die "More than one path to <$v>: <@$aPath> and <$k $v>"; } $hPaths{$v} = [ $k, @$aPath]; $aPath = $hPaths{$k}; if (!$aPath) { $hPaths{$k} = [ $k ]; } elsif ($#$aPath != 0) { die "More than one path to <$k>: <@$aPath> and <$k>"; } $hOut->{$k} = {$v => $hOut->{$v}}; delete $hOut->{$v}; next; } #find the path to $k $aPath = $hPaths{$k}; $hPaths{$k} = $aPath = [ $k ] unless $aPath; #follow path to hash for key $k my $hNode=$hOut; my $i=0; $hNode=$hNode->{$aPath->[$i++]} while $i< $#$aPath; #add pair to hash if ($v == -1) { $hNode->{$k} = $v; } else { $hNode->{$k} = {$v=>{}}; $hPaths{$v} = [ @$aPath, $v ]; } } # a prettier dumper print YAML::Dump($hOut);