Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re: Counting Variations of Key in a Hash

by polettix (Vicar)
on Aug 09, 2005 at 17:03 UTC ( #482304=note: print w/replies, xml ) Need Help??


in reply to Counting Variations of Key in a Hash

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 ;
which gives
$VAR1 = { 'HIPPO1' => { 'Arizona' => [ 'ZOO_1', 'ZOO_2' ], 'Indiana' => [ 'ZOO_2' ], 'Nevada' => [ 'ZOO_7', 'ZOO_3' ] }, 'HIPPO2' => { 'Arizona' => [ 'ZOO_1', 'ZOO_2' ], 'Indiana' => [ 'ZOO_2' ], 'Nevada' => [ 'ZOO_7', 'ZOO_3' ] }, 'HIPPO3' => { 'Arizona' => [ 'ZOO_1', 'ZOO_2' ], 'Indiana' => [ 'ZOO_2' ], 'Nevada' => [ 'ZOO_7', 'ZOO_3' ] }, 'HIPPO4' => { 'Arizona' => [ 'ZOO_1', 'ZOO_2' ], 'Indiana' => [ 'ZOO_2' ], 'Nevada' => [ 'ZOO_7', 'ZOO_3' ] }, 'HIPPO5' => { 'Arizona' => [ 'ZOO_1', 'ZOO_2' ], 'Indiana' => [ 'ZOO_2' ], 'Nevada' => [ 'ZOO_7', 'ZOO_3' ] }, 'LION1' => { 'Nevada' => [ 'ZOO_4' ] }, 'MONKEY2' => { 'Nevada' => [ 'ZOO_12' ] }, 'PUMA1' => { 'Arizona' => [ 'ZOO_5', 'ZOO_3' ], 'Indiana' => [ 'ZOO_5', 'ZOO_3' ] }, 'PUMA2' => { 'Arizona' => [ 'ZOO_5', 'ZOO_3' ], 'Indiana' => [ 'ZOO_5', 'ZOO_3' ] }, 'PUMA3' => { 'Arizona' => [ 'ZOO_5', 'ZOO_3' ], 'Indiana' => [ 'ZOO_5', 'ZOO_3' ] }, 'PUMA4' => { 'Arizona' => [ 'ZOO_5', 'ZOO_3' ], 'Indiana' => [ 'ZOO_5', 'ZOO_3' ] }, 'ZEBRA1' => { 'Indiana' => [ 'ZOO_9', 'ZOO_6' ] }, 'ZEBRA2' => { 'Indiana' => [ 'ZOO_9', 'ZOO_6' ] } };
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: note [id://482304]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (4)
As of 2020-05-25 05:55 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If programming languages were movie genres, Perl would be:















    Results (143 votes). Check out past polls.

    Notices?