Re: 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);
[download]

___________
Eric Hodges

Comment on Re: How to get a ideal hash Download Code

Replies are listed 'Best First'.

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);
[download]

___________
Eric Hodges

[reply]
[d/l]


Perl-Sensitive Sunglasses
	PerlMonks