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

Finding hashes in hashes of hashes

by cyphy (Initiate)
on Dec 28, 2009 at 00:38 UTC ( [id://814561]=perlquestion: print w/replies, xml ) Need Help??

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

Hello! Given I have a hash of hashes, like in the following example:
%families= ( flintstones => { father => "fred", mother => "willma", kid => "bambam", }, simpsons => { father => "homer", mother => "marge", kid => "bart", }, }
I want to create a function, which returns 'simpsons', when I do:
get_kid($families,"bart"); # should return simpsons
I also want it to return an error or die, if it can't be found.

Replies are listed 'Best First'.
Re: Finding something in hashes of hashes
by bobf (Monsignor) on Dec 28, 2009 at 00:52 UTC

    This sounds fairly straightforward. What have you tried?

    The sub is given a hashref ($families) and the value of a key in the inner hash ('bart'). The key to look in is specified in the sub name ('kid'). In pseudocode, I would do something like this:

    for each family surname in the hash (%$families) get the value of the 'kid' key for the corresponding family hash if the value is 'bart', return the surname if the for loop completes the value wasn't found, so return or die

    I hope that gets you started. Feel free to come back with more specific questions. Good luck!

Re: Finding hashes in hashes of hashes
by ahmad (Hermit) on Dec 28, 2009 at 01:23 UTC

    First of all you should be using strict & warnings (I Think you are not) as you are not declaring your variables with 'my' or 'our'

    Anyway, Something like t his might work for you.

    my %families = ( flintstones => { father => "fred", mother => "willma", kid => "bambam", }, simpsons => { father => "homer", mother => "marge", kid => "bart", }, ); print getfamily(\%families,'bart','kid'); sub getfamily { my ($families,$member,$type) = @_; foreach my $family ( keys %{ $families } ) { while ( my ($status,$name) = each %{ $families{$family} } ) { if ( $status eq $type && $member eq $name ) { return $family; } } } return undef; }

    Update: Modified code to account for status as per bobf replay.

    I'll leave it to the OP to choose what he wants to do with duplicates.

      That's a step in the right direction, but it fails to test the relationship (called $status in your example) to ensure the match is on the 'kid' key. Your code, as written, will return the surname of the first family tested that contains the name of interest. For example, if the Flintstones' father was also named 'bart' and if that family came first in the foreach loop, the function would return 'flintstones' rather than 'simpsons'.

      BTW, the OP did not specify how the code should handle multiple matches (in the event more than one family has a 'kid' named 'bart').

Re: Finding hashes in hashes of hashes
by AnomalousMonk (Archbishop) on Dec 28, 2009 at 15:24 UTC

    cyphy, you got homework to do over Christmas break?
    Bummer!

    Update: Anyway, here's my approach. Note that I do not die in the extraction function on zero members; I feel this sort of thing should be left to the caller. (Note: Older versions of Test::More don't have note.)

    >perl -wMstrict -le "my %families = ( flintstones => { dad => 'fred', mom => 'wilma', kid => 'bambam', }, simpsons => { dad => 'fred', mom => 'marge', kid => 'bart', sis => 'lisa', }, ); use Test::More 'no_plan'; my @got; is @got = get_members(\%families => kid => 'bart'), 1, 'got bart'; note qq{families with bart: '@got'}; is @got = get_members(\%families => dad => 'fred'), 2, 'got freds'; note qq{families with freds: '@got'}; is @got = get_members(\%families => mom => 'june'), 0, 'no junes'; note qq{families with june: '@got'}; is @got = get_members(\%families => sis => 'lisa'), 1, 'got lisa'; note qq{families with lisa: '@got'}; is @got = get_members(\%families => xxx => 'yyy'), 0, 'no xxx'; note qq{what's an xxx? '@got'}; sub get_members { my ($hr_families, $member, $name) = @_; return grep $hr_families->{$_}{$member} eq $name, grep exists($hr_families->{$_}{$member}), keys %$hr_families ; } " ok 1 - got bart # families with bart: 'simpsons' ok 2 - got freds # families with freds: 'simpsons flintstones' ok 3 - no junes # families with june: '' ok 4 - got lisa # families with lisa: 'simpsons' ok 5 - no xxx # what's an xxx? '' 1..5

    Also: Noticed that undefined family members would generate 'Uninitialized ...' warnings; fixed. (The two grep statements could be combined into one.)

      Thanks for you answer. It solves my problem! No, it is not my homework (got something else). I'm just trying to create a script where I need something similar (no families and no flinstones ;). I didn't want to write the full code, since I only need this in a single sub. I am using strict, warnings, diagnostics and even perlcritic (cruel). I played around with something like this:
      get_family_member('bart',$families); sub get_family_member { my @args = @_; my $who = shift @args; my $families = shift @args; foreach my $family (%families) { if ($families->{$family}->{kid} eq "bart") { return $dfamilies->{$family}->{kid}; last; } } }
      but where would I say, it should die, when 'bart' is not found? It has been a while since I used perl the last time. I returned, because I missed the nice community and CPAN. However, since I used some more exotic languages (far away from C-like styles and paradigms) I guess I need to rewire my brain. I hope I remember correctly, how Perls scopes and datatypes work. Maybe I should just try to find my old perl books.

        The 'die' would go after the foreach (refer to the pseudocode that I posted). Note the comments below:

        sub get_family_member { my @args = @_; my $who = shift @args; # <-- this var is not used my $families = shift @args; foreach my $family (%families) { if ($families->{$family}->{kid} eq "bart") { # <-- are you sure yo +u want to hard-code 'bart'? I think you need $who return $dfamilies->{$family}->{kid}; # <-- typo in hash name last; # <-- this will never be reached since it already returned } } # no matches found: die here }

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (7)
As of 2024-03-28 10:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found