Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Counting Variations of Key in a Hash

by neversaint (Deacon)
on Aug 09, 2005 at 15:00 UTC ( #482234=perlquestion: print w/ replies, xml ) Need Help??
neversaint has asked for the wisdom of the Perl Monks concerning the following question:

Dear Masters,
My question here is an extention to my earlier postings. In particular to the answer given by frodo72.

I am extending the very first block of his code. The intention is to include variations of the animal during the counting. Such that given this:
my %bighash = ( 'Arizona'=> { 'ZOO_1' => [ '5','HIPPO1', ['feat1'],['feat2']], 'ZOO_2' => [ '10','HIPPO2',['feat1'],['feat2']], 'ZOO_3' => [ '2', 'PUMA1', ['feat1'],['feat2']], 'ZOO_5' => [ '13', 'PUMA2',['feat1'],['feat2']], }, 'Indiana' => { 'ZOO_2' => [ '10','HIPPO3', ['feat1'],['feat2']], 'ZOO_9' => [ '25','ZEBRA1', ['feat1'],['feat2']], 'ZOO_5' => [ '13','MONKEY1', ['feat1'],['feat2']], 'ZOO_6' => [ '23','ZEBRA2', ['feat1'],['feat2']], 'ZOO_3' => [ '2', 'PUMA3', ['feat1'],['feat2']], 'ZOO_5' => [ '1', 'PUMA4', ['feat1'],['feat2']], }, 'Nevada' => { 'ZOO_3' => [ '3', 'HIPPO4', ['feat1'],['feat2']], 'ZOO_7' => [ '11', 'HIPPO5', ['feat1'],['feat2']], 'ZOO_4' => [ '21', 'LION1', ['feat1'],['feat2']], 'ZOO_12' => [ '13','MONKEY2',['feat1'],['feat2']], }, );
My code below:
my %animals; my @zoos; foreach my $state (keys %bighash) { foreach my $zoo (keys %{$bighash{$state}}) { foreach my $state2 (keys %bighash) { foreach my $zoo2 (keys %{$bighash{$state2}}) { my $animal1 = $bighash{$state}{$zoo}[1]; my $animal2 = $bighash{$state2}{$zoo2}[1]; if ( is_variation($animal1,$animal2) == 1 ) { #print "$animal1 - $animal2\n"; push @zoos, $zoo; } push @{$animals{$animal1}{$state}}, [@zoos]; } } } } print Dumper \%animals ; sub is_variation { #Test if two animals are variation of others: #e.g. HIPPO1 - HIPPO2 -> True # HIPPO1 - MONKEY2 -> False my ($s1,$s2) = @_; my ($t1,$t2); $s1 =~ /([A-Za-z]+)(\d+)$/; $t1 = $1; $s2 =~ /([A-Za-z]+)(\d+)$/; $t2 = $1; #print "$t1-$t2\n"; if ( $t1 eq $t2 ) { return 1; } return 0; }
Should've given this:
__END__ $VAR1 = { 'HIPPO1' => { 'Arizona'=> ['ZOO_1', 'ZOO_2'], # from Zoo1_1 HIPPO1 and Zoo_2 HIPPO2 'Indiana'=> ['ZOO_2'], 'Nevada' => ['ZOO_3', 'ZOO_7'], } # So the hash above contain list of States and # Zoos that own variations of Hippo (HIPPO1..5) # Same thing apply for animals below: 'HIPPO2' => { 'Arizona'=> ['ZOO_1', 'ZOO_2'], 'Indiana'=> ['ZOO_2'], 'Nevada' => ['ZOO_3', 'ZOO_7'], } 'HIPPO3' => { 'Arizona'=> ['ZOO_1', 'ZOO_2'], 'Indiana'=> ['ZOO_2'], 'Nevada' => ['ZOO_3', 'ZOO_7'], } 'HIPPO4' => { 'Arizona'=> ['ZOO_1', 'ZOO_2'], 'Indiana'=> ['ZOO_2'], 'Nevada' => ['ZOO_3', 'ZOO_4'], } 'HIPPO5' => { 'Arizona'=> ['ZOO_1', 'ZOO_2'], 'Indiana'=> ['ZOO_2'], 'Nevada' => ['ZOO_3', 'ZOO_4'], } 'PUMA1' => { 'Arizona'=> ['ZOO_3', 'ZOO_5'], 'Indiana'=> ['ZOO_3', 'ZOO_5'], } 'PUMA2' => { 'Arizona'=> ['ZOO_3', 'ZOO_5'], 'Indiana'=> ['ZOO_3', 'ZOO_5'], } 'PUMA3' => { 'Arizona'=> ['ZOO_3', 'ZOO_5'], 'Indiana'=> ['ZOO_3', 'ZOO_5'], } 'PUMA4' => { 'Arizona'=> ['ZOO_3', 'ZOO_5'], 'Indiana'=> ['ZOO_3', 'ZOO_5'], } 'MONKEY1' => { 'Indiana'=> ['ZOO_5'], 'Nevada'=> ['ZOO_12'], } 'MONKEY2' => { 'Indiana'=> ['ZOO_5'], 'Nevada'=> ['ZOO_12'], } 'ZEBRA1' => { 'Indiana'=> ['ZOO_6','ZOO_9'], } 'ZEBRA2' => { 'Indiana'=> ['ZOO_6','ZOO_9'], } 'LION1' => { 'Nevada'=> ['ZOO_4'], } };
But it doesn't. Is there anything I miss in my code there?

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

Comment on Counting Variations of Key in a Hash
Select or Download Code
Re: Counting Variations of Key in a Hash
by davidrw (Prior) on Aug 09, 2005 at 15:29 UTC
    So the end result for HIPPO1 and HIPPO2 should be the same, right? Assuming that, the following ends up with HIPPO as a key (no number -- just the 'root' name) (note that hashing on the 'root' animal name also eliminates the need for the nested looping over bigHash):
    my %animals; while( my ($state, $zoos) = each %bighash ){ while( my ($zoo, $row) = each %$zoos ){ my $animal = $row->[1]; $animal =~ s/\d+$//; push @{$animals{$animal}->{$state}}, $zoo; } }
    Note in your original code that @zoos probably shouldn't be globally scoped.
Re: Counting Variations of Key in a Hash
by polettix (Vicar) on Aug 09, 2005 at 17:03 UTC
    davidrw basically gave the core answer in his reply. As I suggested in the answer you cite, you should probably try to think a basic working algorithm even if it's not optimised and it requires more passes to be executed.

    If this is exactly what you need, davidrw's answer will not suffice, of course. In this case, instead of trying to do all the work in one multi-nested loop (whatever the nesting depth), I'd stick to do one thing at a time and proceed by steps. In this case, you should track the variations together with the other stuff:

    #!/usr/bin/perl use strict; use warnings; use Storable qw( freeze thaw ); use Data::Dumper; my %bighash = ( 'Arizona'=> { 'ZOO_1' => [ '5','HIPPO1', ['feat1'],['feat2']], 'ZOO_2' => [ '10','HIPPO2',['feat1'],['feat2']], 'ZOO_3' => [ '2', 'PUMA1', ['feat1'],['feat2']], 'ZOO_5' => [ '13', 'PUMA2',['feat1'],['feat2']], }, 'Indiana' => { 'ZOO_2' => [ '10','HIPPO3', ['feat1'],['feat2']], 'ZOO_9' => [ '25','ZEBRA1', ['feat1'],['feat2']], 'ZOO_5' => [ '13','MONKEY1', ['feat1'],['feat2']], 'ZOO_6' => [ '23','ZEBRA2', ['feat1'],['feat2']], 'ZOO_3' => [ '2', 'PUMA3', ['feat1'],['feat2']], 'ZOO_5' => [ '1', 'PUMA4', ['feat1'],['feat2']], }, 'Nevada' => { 'ZOO_3' => [ '3', 'HIPPO4', ['feat1'],['feat2']], 'ZOO_7' => [ '11', 'HIPPO5', ['feat1'],['feat2']], 'ZOO_4' => [ '21', 'LION1', ['feat1'],['feat2']], 'ZOO_12' => [ '13','MONKEY2',['feat1'],['feat2']], }, ); my %animals; { # Scope reduction, could be put inside a function :) my %tmp; while ( my ($state, $zoos) = each %bighash ) { while ( my ($zoo, $row) = each %$zoos ){ my $animal = $row->[1]; (my $root = $animal) =~ s/\d+$//; $tmp{$root}{variations}{$animal} = 1; push @{$tmp{$root}{data}{$state}}, $zoo; } } # Now we traverse %tmp to create the needed structure foreach my $href (values %tmp) { # Use freeze/thaw from Storable to do deep hash copying my $frozen = freeze($href->{data}); $animals{$_} = thaw($frozen) foreach keys %{$href->{variations}} } } $Data::Dumper::Sortkeys = 1; print Dumper \%animals ;
    You'll notice that I'm using Storable to do deep hash copying, but you can use other methods of course. If you can share the data between similar animals, you can get rid of this copying and do simply:
    foreach my $href (values %tmp) { $animals{$_} = $href->{data} foreach keys %{$href->{variations}} }
    For some considerations about this deep (or shallow) copy stuff you can also start from this thread, and in particular from pelagic's answer.

    Flavio
    perl -ple'$_=reverse' <<<ti.xittelop@oivalf

    Don't fool yourself.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (11)
As of 2014-09-16 14:18 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (26 votes), past polls