in reply to Re: Accumulating a Hash from Pairwise Comparison
in thread Accumulating a Hash from Pairwise Comparison

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. 
#!/usr/bin/perl -w
use strict;
use Data::Dumper;

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

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


my @sd = keys(%seed);

OUTER: foreach  my $sd ( @sd )
{
    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.
                    $seed{$mn."-join"} ||= {};
                    
                    # Create array if it doesn't exist.
                    $seed{$mn."-join"}{$sdsub} ||= [];
                    
                    my $store = $seed{$mn."-join"}{$sdsub};
                   
                    # I want to push the new hash in the %seed key set
                    # (updating them)
                    # So that later it can be called again recursively
                    
                    my $tmpstr = $mn."-join";
                    push @sd, $tmpstr;

                    foreach  my $valmain( @{$main{$mn}{$msec}}  )
                    {
                      push @$store, $valmain.$valseed;
                      last OUTER if (length($valmain.$valseed) == 4);

                      # length equal 4 here so that we can
                      # capture str with length 3 (?)
                    }
               
                }
            }
        }
    }
}

print scalar(keys %seed),"\n";
print Dumper \%seed;

[download]


---
neversaint and everlastingly indebted.......

Replies are listed 'Best First'.
Re^3: Accumulating a Hash from Pairwise Comparison
by ikegami (Patriarch) on Sep 08, 2005 at 14:36 UTC

    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