in reply to Accumulating a Hash from Pairwise Comparison

1) You keep replacing the array referenced by $main{$mn."-join"}{$msec} instead of adding to it.

2) last INNER if (length($join) > 2); is a bad way of not treating your outputs as inputs.

use strict;
use warnings;

use Data::Dumper;

my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],},
             'main2' => {'m2sec1'=> ['D','E','F'],},);

my %seed = ( 'seed' => {'seed1'=> ['X','Y','Z']},);

# Keep output seperate for now to
# avoid treating outputs as inputs.
my %joined;

foreach  my $sd ( keys %seed )
{
    foreach  my $sdsub ( sort keys %{$seed{$sd}} )
    {
        foreach  my $valseed ( @{$seed{$sd}{$sdsub}}  )
        {
            foreach  my $mn ( keys %main )
            {
                foreach  my $msec ( sort keys %{$main{$mn}} )
                {
                    # Create hash if it doesn't exist.
                    $joined{$mn."-join"} ||= {};
                    
                    # Create array if it doesn't exist.
                    $joined{$mn."-join"}{$msec} ||= [];
                    
                    my $store = $joined{$mn."-join"}{$msec};


                    foreach  my $valmain( @{$main{$mn}{$msec}}  )
                    {
                        push @$store, $valmain.$valseed;
                    }
                }
            }
        }
    }
}

# Combine inputs and outputs.
%main = (%main, %joined);

print Dumper \%main ;

[download]

Update: It's a bit cleaner if you change the order of the loops, putting outputs at the top level.

use strict;
use warnings;

use Data::Dumper;

my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],},
             'main2' => {'m2sec1'=> ['D','E','F'],},);

my %seed = ( 'seed' => {'seed1'=> ['X','Y','Z']},);

foreach  my $mn ( keys %main )
{
    my $joined = $main{"$mn-join"} = {};

    foreach  my $msec ( sort keys %{$main{$mn}} )
    {
        my $store = $joined->{$msec} = [];

        foreach  my $valmain( @{$main{$mn}{$msec}}  )
        {
            foreach  my $sd ( keys %seed )
            {
                foreach  my $sdsub ( sort keys %{$seed{$sd}} )
                {
                    foreach  my $valseed ( @{$seed{$sd}{$sdsub}}  )
                    {
                            push @$store, $valmain.$valseed;
                    }
                }
            }
        }
    }
}

print Dumper \%main ;

[download]

Update: It seems wierd to me that %seed is a HoHoA instead of just an array, since the entire contents of the HoHoA are treated as a single array. This generates the same output (and is probably slightly faster):

use strict;
use warnings;

use Data::Dumper;


my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],},
             'main2' => {'m2sec1'=> ['D','E','F'],},);

my %seed = ( 'seed' => {'seed1'=> ['X','Y','Z']},);


my @seed;  # Flattened %seed.

foreach  my $sd ( keys %seed )
{
    foreach  my $sdsub ( sort keys %{$seed{$sd}} )
    {
        push @seed, @{$seed{$sd}{$sdsub}};
    }
}


foreach  my $mn ( keys %main )
{
    my $joined = $main{"$mn-join"} = {};

    foreach  my $msec ( sort keys %{$main{$mn}} )
    {
        my $store = $joined->{$msec} = [];

        foreach  my $valmain( @{$main{$mn}{$msec}}  )
        {
            foreach  my $valseed ( @seed  )
            {
                push @$store, $valmain.$valseed;
            }
        }
    }
}


print Dumper \%main ;

[download]

Replies are listed 'Best First'.
Re^2: Accumulating a Hash from Pairwise Comparison
by neversaint (Deacon) on Sep 08, 2005 at 05:29 UTC
    Dear ikegami,
    Thanks so much for your reply. I have further question, I hope you wont' mind.

    Suppose I want to:
    1. Add the resulting appended hash into "%seed"
    2. And then use that new appended hash in %seed recursively again, keep appending it.
    3. It stops until the length of the appended string is 3 (later can be any other length).

    I tried to modify your first example, but I'm still stuck.

    The problem with my code below mainly because the %seed has doesn't get updated, only the array that grows. What we intend is to have accumulated %seed with uniformed length in the array element (length of the element is extended longer than the initial seed).

    How should I go about it? I am so sorry for troubling you so much. Really hope you don't mind to look at it.
    Read more... (2 kB)


    ---
    neversaint and everlastingly indebted.......
[reply]
[d/l]

      What is your desired output? Listing what should be in main1-join will do the trick.

      Update: How's this?

      use strict;
use warnings;

use Data::Dumper;


# Inputs.

my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],},
             'main2' => {'m2sec1'=> ['D','E','F'],},);

my @seed = ( 'X','Y','Z' );

my $output_length = 3;


# Create a work area since we can't
# modify the existing content of %main.

my %work;

foreach my $mn ( keys %main )
{
    foreach my $msec ( sort keys %{$main{$mn}} )
    {
        $work{"$mn-join"}{$msec} = [ @{$main{$mn}{$msec}} ];
    }
}


# Repeatedly multiply matrices (in place).

$output_length--;

while ($output_length--)
{
    foreach my $mn ( keys %work )
    {
        foreach my $msec ( sort keys %{$work{$mn}} )
        {
            my @store;

            foreach my $val1 ( @{$work{$mn}{$msec}} )
            {
                foreach my $val2 ( @seed )
                {
                    push(@store, "$val1$val2");
                }
            }

            $work{$mn}{$msec} = \@store;
        }
    }
}


# Merge output with %main.

%main = (%main, %work);


# Show updated %main.

print(Dumper(\%main));

      [download]

      Update: A simpler variation:

      use strict;
use warnings;

use Data::Dumper;


# Inputs.

my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],},
             'main2' => {'m2sec1'=> ['D','E','F'],},);

my @seed = ( 'X','Y','Z' );

my $output_length = 3;


# Multiply the seed vector with itself as much as requested.

my @seedx = @seed;

for ( 3 .. $output_length )
{
    my @input = @seedx;

    @seedx = ();

    foreach my $val1 ( @input )
    {
        foreach my $val2 ( @seed )
        {
            push(@seedx, "$val1$val2");
        }
    }
}


# Multiply vectors against seed matrix.

foreach my $mn ( keys %main )
{
    foreach my $msec ( sort keys %{$main{$mn}} )
    {
        my $store = $main{"${mn}-join"}{$msec} = [];

        foreach my $val1 ( @{$main{$mn}{$msec}} )
        {
            foreach my $val2 ( @seedx )
            {
                push(@$store, "$val1$val2");
            }
        }
    }
}


# Show updated %main.

print(Dumper(\%main));

      [download]

      Update: If $output_length will always be 3:

      use strict;
use warnings;

use Data::Dumper;


my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],},
             'main2' => {'m2sec1'=> ['D','E','F'],},);

my @seed = ( 'X','Y','Z' );


foreach my $mn ( keys %main )
{
    foreach my $msec ( sort keys %{$main{$mn}} )
    {
        my $store = $main{"${mn}-join"}{$msec} = [];

        foreach my $val1 ( @{$main{$mn}{$msec}} )
        {
            foreach my $val2 ( @seed )
            {
                foreach my $val3 ( @seed )
                {
                    push(@$store, "$val1$val2$val3");
                }
            }
        }
    }
}


# Show updated %main.

print(Dumper(\%main));

      [download]
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom