Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
PerlMonks  

HoH and accumulation

by djbiv (Scribe)
on Jan 27, 2004 at 18:38 UTC ( [id://324506]=perlquestion: print w/replies, xml ) Need Help??

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

I have a hash of a hash that I would like to accumulate 'matching' keys with (if that makes sense?). Basically I am reading in some files to gather data and attempt to create some totals. The following code gets my HoH created but I’m not sure how to lookup matching sub keys in the second layer. The HoH basically looks like the following and I would like to add the 'value' when the 'second?' key matches. So $VAR2 contains '01:4928' in the first hash and $VAR2 contains the same key '01:4928' add the corresponding values for those keys. Please forgive the ugly code. Thanks in advance
$VAR1 = 'UE_RTB_H2H_TPS_20040127.DAT'; $VAR2 = { '01:4928' => '00', '00:4355' => '00', '04:4060' => '00', '03:2142' => '00', '02:3251' => '00', $VAR1 = 'UE_RTB_H2H_TPS_20040127.DAT'; $VAR2 = { '01:4928' => '01', '00:4355' => '02', '04:4060' => '00', '03:2142' => '01', '02:3251' => '00', '01:404' => '00', '00:3020' => '00', '00:2237' => '00', '00:3020' => '00', '00:2237' => '00', foreach $current_tps_file (sort readdir(TPS)) { my %total_hash; if ($current_tps_file =~ /^$args{b}$args{n}\w+$tps_pre_date_name$arg +s{d}$args{p}/) { # OK got a file that meets the match criteria above. open (TPS_FILE, "$current_tps_file") || die "FILE NOT OPEN: $!"; print "READING: $current_tps_file ...\n"; my @lines=<TPS_FILE>; # each @line array contains 1 minute. shift @lines; foreach my $line (@lines[1..$#lines]) { my @minute = (split (/ /, $line) ); my $current_time = $minute[0]; shift @minute; pop @minute; my $second = 0; foreach my $count (@minute){ $second++; my $key = $current_time . $second; #print "$key"; $total_hash{$key} = $count; $all_files{$current_tps_file} = \%total_hash; } } } close (TPS_FILE); } closedir (TPS); print Dumper(%all_files);
UPDATE: basically I would like to be able to search for common keys like below but in a HoH instead of two different hashes?
my @common = (); foreach (keys %hash1) { push(@common, $_) if exists $hash2{$_}; }

BazB: use vanilla single quotes

Replies are listed 'Best First'.
Re: HoH and accumulation
by tilly (Archbishop) on Jan 27, 2004 at 19:36 UTC
    First, style nits. In your open or die, have the filename in your error message. That will help debugging if anything goes wrong later. Similarly using strict.pm avoids a lot of subtle bugs, particularly when you start working with nested data structures. (A typo can mean that you are accessing a very different place than you think you are.) I can tell that you can't be doing that because you haven't done things like declare $current_tps_file with my.

    With those nits out of the way, here are a few workable strategies.

    The most general is to generate a hash, by key, of which subhashes have that key. For instance (all code is untested):

    my %with_key; foreach my $first_key (keys %all_files) { foreach my $second key (keys %{$all_files{$first_key}}) { push @{$with_key{$second_key}}, $first_key; } }
    That generates a hash of arrays. Now you use that to figure out whatever you want. (At the cost of possibly having to write lots of code.)

    A second strategy is to say that it makes no sense to search the entire data structure to produce a complex new data structure that you have to search again. So if what you need is simple, then you could walk all of the data and generate the totals that you need in one pass:

    my %total; foreach my $subhash (values %all_files) { foreach my $key (keys %$subhash) { $total{$key} += $subhash->{$key}; } }
    In fact if you're going to do that, there is no reason not to move generating %total into the original pass through the file.

    I don't know exactly what you want to do, but either of these strategies will work.

    UPDATE: I added an arrow in the second code snippet to dereference $subhash. This is the kind of typo that strict.pm catches for me when I try to run code...

      thank you for your post! however trying to implement your second solution I am failing to see how this is adding the common keys within my HoH? I am using strict and warnings, the code above was just a snip from the entire program. Here is the code I threw in and played with.
      my %total; my %subhash; foreach my $subhash (values %all_files) { foreach my $key (keys %$subhash) { my $junk = $total{$key} + $subhash{$key}; print "$junk\n"; } }
      the results of adding this to total the values for the common keys always results in '0'? I have also tried creating a AoH instead but still have problems getting the correct accumalation... Here is the code for that.
      for my $i ( 0 .. $#AoH ) { for my $role (sort keys %{ $AoH[$i] } ) { my $tcount = $AoH[$i]{$role} + $AoH[$i]{$role}; print "$role=$tcount\n"; } }
      either way what I would like to accomplish is for each common key within the hash (either below the main array or main hash) accumalate the value for common keys...? maybe I'm just brain dead at this point from looking at it too long... thanks...
        I'm sorry, that was due to a typo on my part (I did warn that the code was untested).

        You need to write $subhash->{$key} and not $subhash{$key} because you need to dereference the scalar $subhash, not access %subhash. (As I note in my update, strict.pm catches this kind of bug for you.)

        If this fix confuses you, then I'd highly recommend reading references quick reference.

Re: HoH and accumulation
by dragonchild (Archbishop) on Jan 27, 2004 at 19:27 UTC
    You're looking for the intersection between the sets of keys in both hashes. So, something like this should work:
    my %common; $common{$_}++ for keys(%hash1), keys(%hash2); my @common = grep { $common{$_} > 1 } keys %common;

    ------
    We are the carpenters and bricklayers of the Information Age.

    Please remember that I'm crufty and crochety. All opinions are purely mine and all code is untested, unless otherwise specified.

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others musing on the Monastery: (3)
As of 2024-04-20 04:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found