laziness, impatience, and hubris PerlMonks

### How to get a ideal hash

by pysome (Scribe)
 on Apr 03, 2009 at 10:34 UTC Need Help??
pysome has asked for the wisdom of the Perl Monks concerning the following question:

```my \$h= {
(4,-1),
(2,6),
(6,4),
(3,5),
(5,-1),
(99,-1),
};
I wanna change \$h to a hash like this:
```\$hh{2}{6}{4} = -1;
\$hh{3}{5}    = -1;
\$hh{99}      = -1;
That's to say, i wanna join them in <key,value> order,the pre-element's value is post-element's key,until the key is -1
The keys is unique ,but the "-1" is not. How to fulfill it? Thanks

Replies are listed 'Best First'.
Re: How to get a ideal hash
by BrowserUk (Pope) on Apr 03, 2009 at 13:08 UTC

This could probably be simplified a little:

```#! perl -sw
use strict;
use Data::Dump qw[ pp ];

my \$h= {
(4,-1),
(2,6),
(6,4),
(3,5),
(5,-1),
(99,-1),
};

my %invert;
push @{ \$invert{ \$h->{ \$_ } } }, \$_ for keys %{ \$h };

my %hh;
for( @{ \$invert{ -1 } } ) {
my \$ref = { \$_, -1 };
while( exists \$invert{ \$_ } ) {
my \$key = pop @{ \$invert{ \$_ } };
\$ref = { \$key, \$ref };
delete \$invert{ \$_ } unless @{ \$invert{ \$_ } };
\$_ = \$key;
}
my( \$key, \$value ) = each %\$ref;
\$hh{ \$key } = \$value;
}

pp \%hh;
__END__
c:\test>755232
{
2 => { 6 => { 4 => -1 } },
3 => { 5 => -1 },
9 => -1
}

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
Re: How to get a ideal hash
by derby (Abbot) on Apr 03, 2009 at 13:14 UTC

I've often seen this for hierarchical data -- like you have flat hash (sql results) for some type of hierarchical data. There's probably a more efficient way of doing this but basically you want to chain the keys together until you hit some base criteria. Here's a first cut attempt (using references because i find it easier):

```#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

my \$nested_hash = {};
my \$flat_hash   = {
4 => -1,
2 => 6,
6 => 4,
3 => 5,
5 => -1,
99 => -1,
};

print Dumper( \$flat_hash );

# We need to keep track of what we've all ready chained
my \$seen = {};

foreach my \$key ( sort keys %\$flat_hash ) {
next if defined( \$seen->{\$key} );
add_chain( \$flat_hash, \$nested_hash, \$seen, \$key );
}

print Dumper( \$nested_hash );

my( \$flat_hash, \$nested_hash, \$seen, \$key ) = @_;

# if we've all ready added this key to the nested hash, ignore it
return if defined( \$seen->{\$key} );
\$seen->{\$key} = 1;

my \$current_key = \$flat_hash->{\$key};

if( \$current_key == -1 ) {
# base case
\$nested_hash->{\$key} = \$flat_hash->{\$key};
}  else {
my \$chain            = {};
\$nested_hash->{\$key} = \$chain;
add_chain( \$flat_hash, \$chain, \$seen, \$current_key );
}
}
produces:
```\$VAR1 = {
'6' => 4,
'99' => -1,
'4' => -1,
'3' => 5,
'2' => 6,
'5' => -1
};
\$VAR1 = {
'99' => -1,
'3' => {
'5' => -1
},
'2' => {
'6' => {
'4' => -1
}
}
};
-derby
Re: How to get a ideal hash
by ELISHEVA (Prior) on Apr 03, 2009 at 14:44 UTC

In your post (OP) you specify that all numbers other than "-1" are "unique" - but what exactly do you mean? Do you mean that

1. each number appears only once on the left side of (x, y)?
2. do you mean that there is a unique path to each number except -1? That is, if we find \$h{2}{6}{4} we will never find a sequence of pairs such that \$h{7}{11}{6}{4}.

The two statements are quite different. Unless you are absolutely certain a priori that (2) is true, your algorithm is going to need to check for multiple paths to each number. Then you will have to decide whether those multiple paths are an error or not. Assuming that multiple paths to each number are an error, your code will need to keep track of each path found to each number.

I posted code below to illustrate the point, mainly as a contrast to BrowserUk's elegant solution. I do so with reservations. Bloodnok is right - it is considered bad form on Perl Monks to post a question without at least trying to show your own efforts. But BrowserUK is right too - the OP has posted a difficult problem. We aren't trying to be mean when we say do it yourself: it is just that we are donating our time so others can learn. Trying to solve the problem on your own is essential to really understanding the solution. For further discussion of the point, see The path to mastery.

Best, beth

I do so with reservations. Bloodnok is right - it is considered bad form on Perl Monks to post a question without at least trying to show your own efforts.

For simple problems I might agree, but this is decidely non-trivial. Should people refrain from asking if they have a difficult problem and have no idea how to start to solve it?

Personally, I think this is an interesting problem, clearly defined and it deserved an answer.

I also find that many of the "what have you tried" missives are self-serving.

Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.
browserUk++. "What have you tried" but also "This looks like homework", which of course, begs the question of what classes someone may have had who is thoroughly self taught.

I've answered questions others regarded as simple, trivial, or homework simply because I found the problem to be interesting. And who is to say what any individual finds interesting? Mikhail Tal, for one, delighted in chess problems designed for children.
Looking at some of pysome's previous posts I'm guessing English is not his first language. That may be one reason why he limits what he asks in posts. In fact, it's probably less confusing for us if he does that. I think it's important that we keep in mind that we have people from other parts of the world and people from other professions. Certainly the question could have been presented better but that may be too much to ask of pysome. So kudos to you for finding it interesting enough to answer it!

Elda Taluta; Sarks Sark; Ark Arks

Re: How to get a ideal hash
by Bloodnok (Vicar) on Apr 03, 2009 at 11:16 UTC
...and what have you attempted so far ?

As ELISHEVA is probably tired of saying, this isn't a code writing service - try explaining what you've done and what doesn't seem to work and you might then get some constructive answers.

A user level that continues to overstate my experience :-))
Uh, its not like a program, its just some syntax
```\$hh{2}{6}{4} = -1;
\$hh{3}{5}    = -1;
\$hh{99}      = -1;
use Data::Dumper;
print Dumper( \%hh);
__END__
\$VAR1 = {
'99' => -1,
'3' => {
'5' => -1
},
'2' => {
'6' => {
'4' => -1
}
}
};
No it isn't just some syntax - look at the starting hash in the OP - the problem revolves around the converting the original hash from a flattened linked list to a hash containing the equivalent linked list ... not just rewriting the hash definition..

FWIW, I've solved it thusly:

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

my \$fll= {
(4,-1),
(2,6),
(6,4),
(3,5),
(5,-1),
(99,-1),
};
my \$ll = {};

sub doit {
my \$done = { %\$fll };
while (%\$done) {
foreach (keys %\$done) {
my (\$k,\$v) = (\$_, \$done->{\$_});
if (\$v < 0) {
%\$ll = (%\$ll, (\$k, \$v));
delete \$done->{\$k};
} else {
if (exists \$ll->{\$v}) {
\$ll->{\$k} = {\$v => \$ll->{\$v}};
delete \$done->{\$k};
delete \$ll->{\$v};
}
}
}
}
}

doit();

print Dumper \$fll,\$ll;
gives:
```pointo1d@pointo1d-laptop:~\$ perl tst.pl
\$VAR1 = {
'6' => 4,
'99' => -1,
'4' => -1,
'3' => 5,
'2' => 6,
'5' => -1
};
\$VAR2 = {
'99' => -1,
'3' => {
'5' => -1
},
'2' => {
'6' => {
'4' => -1
}
}
};
As, I think, required

Update:

Added my attempt at a solution.

A user level that continues to overstate my experience :-))
Re: How to get a ideal hash
by eric256 (Parson) on Apr 03, 2009 at 21:22 UTC

As always there is more than one way to do it. I see chains as arrays, so i built arrays first, then looped those to make hashes. Of coures as I wrote this and pasted I realized that this method depends on the right order, so I'm gonna make a second shot, but here is this version for fun:

```#!/usr/bin/perl
use strict;
use warnings;

use Data::Dumper;

my \$pairs = {
(4,-1),
(2,6),
(6,4),
(3,5),
(5,-1),
(99,-1),
};

my @paths;

foreach my \$key (keys %\$pairs) {
my \$value = \$pairs->{\$key};

# if the right hand side matches the start of a chain
# then unshift the left onto the start of the chain
my @start_path = grep { @\$_[0] eq \$value } @paths;
unshift(@{\$start_path[0]}, \$key) if @start_path;

# if the left hand side matches the end of a chain,
# then push the left hand side onto the end
my @end_path = grep { @\$_[-1] eq \$key } @paths;
push( @{\$end_path[0]}, \$value) if @end_path;

push @paths, [\$key, \$value] unless (@start_path or @end_path);
}

my \$hh;
for my \$path (@paths) {
my \$temp = pop @\$path;
my \$key  = shift @\$path;
for (reverse @\$path) {
my \$t = {\$_ => \$temp};
\$temp = \$t;
}
\$hh->{\$key} = \$temp;
}
print Dumper(\$hh);

___________
Eric Hodges

Okay this version finds the ends of the paths, then builds them backwards from their. As long as the data is good it will run fine ;) I added the pair (1,2) which breaks the above code.

```#!/usr/bin/perl
use strict;
use warnings;

use Data::Dumper;

my \$pairs = {
(4,-1),
(2,6),
(6,4),
(1,2),
(3,5),
(5,-1),
(99,-1),
};

my @paths;

#get the ends of all the chains
#then the next pieces, and so on, until all pairs are used.

for my \$key ( grep { \$pairs->{\$_} == -1 } keys %\$pairs ) {
push @paths, [\$key, -1];
delete \$pairs->{\$key};
}

while ( keys %\$pairs ) {
for my \$path ( @paths ) {
for my \$key ( keys %\$pairs ) {
if (\$pairs->{\$key} eq @\$path[0]) {
unshift @\$path, \$key;
delete \$pairs->{\$key};
}
}
}
}

my \$hh;
for my \$path (@paths) {
my \$temp = pop @\$path;
my \$key  = shift @\$path;
for (reverse @\$path) {
my \$t = {\$_ => \$temp};
\$temp = \$t;
}
\$hh->{\$key} = \$temp;
}
print Dumper(\$hh);

___________
Eric Hodges
Re: How to get a ideal hash
by ig (Vicar) on Apr 05, 2009 at 02:06 UTC

Here is yet another solution. This one has a single loop and no recursion.

```#!/usr/local/bin/perl
use strict;
use warnings;
use Data::Dumper;

my \$h= {
(4,-1),
(2,6),
(6,4),
(3,5),
(5,-1),
(99,-1),
};

my %hh;
my %tails;

while(my (\$key, \$value) = each %\$h) {
my \$val;
if(\$value == -1) {
\$val = -1;
} elsif(exists(\$hh{\$value})) {
\$val = { \$value => \$hh{\$value} };
delete(\$hh{\$value});
} else {
\$val = {};
\$tails{\$value} = \$val;
}
if(exists(\$tails{\$key})) {
\$tails{\$key}{\$key} = \$val;
} else {
\$hh{\$key} = \$val;
}
}

print Dumper(\%hh);
Re: How to get a ideal hash
by rir (Vicar) on Apr 08, 2009 at 18:53 UTC
Be well,
rir
```#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;

my \$h = { 4 => -1, 2 => 6, 6 => 4, 3 => 5, 5 => -1, 99 => -1 };

sub LEAF() { -1 }

# Make a list of toplevel keys: values occurring once and not LEAF
my %tl;
++\$tl{\$_} for  grep { \$_ != LEAF }  %\$h ;
my @toplevel =  grep { \$tl{\$_} == 1 } keys %tl;

for my \$k ( @toplevel ) {
\$cursor->{\$k} = \$h->{\$k};

while ( LEAF != ( my \$next_k = \$cursor->{\$k})  ) {
\$cursor = \$cursor->{\$k} =  { \$next_k, \$h->{ \$next_k } };
\$k = \$next_k;
}
}

Create A New User
Node Status?
node history
Node Type: perlquestion [id://755232]
Approved by citromatik
Front-paged by citromatik
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (3)
As of 2018-05-27 03:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
World peace can best be achieved by:

Results (194 votes). Check out past polls.

Notices?