Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Re: How to get a ideal hash

by eric256 (Parson)
on Apr 03, 2009 at 21:22 UTC ( #755344=note: print w/ replies, xml ) Need Help??


in reply to How to get a ideal hash

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


Comment on Re: How to get a ideal hash
Download Code
Re^2: How to get a ideal hash
by eric256 (Parson) on Apr 03, 2009 at 21:32 UTC

    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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://755344]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (6)
As of 2015-07-05 15:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (67 votes), past polls