Re^3: Accumulating a Hash from Pairwise Comparison

[ikegami]

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));

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));

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));