Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

Accumulating a Hash from Pairwise Comparison

by neversaint (Deacon)
on Sep 07, 2005 at 04:05 UTC ( #489762=perlquestion: print w/replies, xml ) Need Help??

neversaint has asked for the wisdom of the Perl Monks concerning the following question:

Dear Masters,
I want to compare these two hashes in pairs. Basically by appending array element from %main with %seed in pairs.
my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],}, 'main2' => {'m2sec1'=> ['D','E','F'],},); my %seed = ( 'seed' => {'seed1'=> ['X','Y','Z']},);
And then accumulating the appended element into %main hash. Such that in the final result will give this:
my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],}, 'main2' => {'m2sec1'=> ['D','E','F'],}, 'main1-join' => { 'm1sec1'=> ['AX','BX','CX', 'AY','BY','CY', 'AZ','AY','AZ'], }, 'main2-join' => { 'm2sec1'=> ['DX','EX','FX', 'DY','EY','FY', 'DZ','EZ','FZ], } );
But how come my code below still doesn't do the job properly?
use Data::Dumper; my %nhash; foreach my $sd ( keys %seed ) { foreach my $sdsub ( sort keys %{$seed{$sd}} ) { my %temphash; foreach my $valseed ( @{$seed{$sd}{$sdsub}} ) { my $join; INNER: foreach my $mn ( keys %main ) { foreach my $msec ( sort keys %{$main{$mn}} ) { my @store; foreach my $valmain( @{$main{$mn}{$msec}} ) { #print $valmain.$valseed,"\n"; $join = $valmain.$valseed; push @store,$join; last INNER if (length($join) > 2); } $temphash{$msec} = [ @store ]; $main{$mn."-join"} = {%temphash}; } } #print "$valseed\n"; } } } print Dumper \%main ;


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

Replies are listed 'Best First'.
Re: Accumulating a Hash from Pairwise Comparison
by ikegami (Pope) on Sep 07, 2005 at 04:39 UTC

    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 ;

    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 ;

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

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

        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));
Re: Accumulating a Hash from Pairwise Comparison
by GrandFather (Sage) on Sep 07, 2005 at 04:40 UTC

    This seems to be what you want:

    use strict; use warnings; use Data::Dumper; my %nhash; my %main = ( 'main1' => {'m1sec1'=> ['A','B','C'],}, 'main2' => {'m2sec1'=> ['D','E','F'],},); my %seed = ( 'seed' => {'seed1'=> ['X','Y','Z']},); my @main1 = @{$main{'main1'}{'m1sec1'}}; my @main2 = @{$main{'main2'}{'m2sec1'}}; my @seed_a = @{$seed{'seed'}{'seed1'}}; my @m1sec1; my @m2sec1; for my $s (@seed_a) { push @m1sec1, "$_$s" for (@main1); push @m2sec1, "$_$s" for (@main2); } $main{'main-join1'} = {'m1sec1' => [@m1sec1]}; $main{'main-join2'} = {'m2sec1' => [@m2sec1]}; print Dumper \%main;

    Perl is Huffman encoded by design.
Re: Accumulating a Hash from Pairwise Comparison
by GrandFather (Sage) on Sep 07, 2005 at 05:52 UTC

    Benchmark time :)

    Rate ig1 ig2 gf ig1 8012/s -- -0% -21% ig2 8013/s 0% -- -21% gf 10181/s 27% 27% --

    Perl is Huffman encoded by design.
Re: Accumulating a Hash from Pairwise Comparison
by injunjoel (Priest) on Sep 07, 2005 at 05:01 UTC
    Greetings all,
    At first glance this reminds me of MatLab code, matrix algreba sort of stuff. With that in mind you might find PDL useful. I am not sure if you are using 'A','B','C' as an example but if you are interested in using strings there is a module for that as well, PDL::Char.

    -InjunJoel
    "I do not feel obliged to believe that the same God who endowed us with sense, reason and intellect has intended us to forego their use." -Galileo

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2019-08-22 04:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?