Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer

Re^3: (another) HoH question

by muba (Priest)
on Jun 23, 2012 at 19:38 UTC ( #978005=note: print w/replies, xml ) Need Help??

in reply to Re^2: (another) HoH question
in thread (another) HoH question

Data::Dumper certainly cleared that up (I had never used this before, and this will become a favorite.)
It works both ways: if you can write down your data structure in a manner that looks like Data::Dumper output, then you can be relatively sure your data is at least syntactically correct.

Anyway. If I get you right, you're reading Set One, which would result in the hash as defined in Listing 1, and then you're reading Set Two, which would alter the original hash to that it becomes the one as defined in Listing Two.

# Listing One: %hash = ( "123" => "abc", "456" => { # I'm chosing for a hashref here becaus +e "abc" => undef, # eventually we'll possibly replacing t +hose "xyz" => undef, # undefs with something else. } "789" => "abc" );
# Listing Two: %hash = ( "123" => {"abc" => "zzz"}, "456" => { "abc" => ["xxx", "yyy"], "xyz" => undef # Or [], or 0, or "", or whatev +er }, "789" => {"abc" => "xxx"} );
use strict; use warnings; use Data::Dump 'pp'; # Or Data::Dumper, but I prefer the pp output. # Note that I'm using scalars here to represent the files. # I'm using Perl's capability to use references-to-scalars # as if they were files. my $setOne = <<EOF abc 123 abc 456 abc 789 xyz 456 EOF ; my $setTwo = <<EOF xxx ==> 456->abc xxx ==> 789->abc yyy ==> 456->abc yyy ==> 456->abc zzz ==> 123->abc EOF ; my %hash; # See? Here I'm opening a file handle to read from $setOne. # Typically, you'd put "somefilename.txt" in place of \$setOne, # but this code if for demonstration purposes only. open my $fileOne, "<", \$setOne or die "Couldn't read set one: $!"; while (my $line = <$fileOne>) { chomp $line; # Goodbye, newlines characters. # It would seem like the order of values and keys is turned around # in the file for set one. That, or I misinterpreted your intentio +n. my ($value, $key) = split(/\s+/, $line); if (ref $hash{$key}) { # If $hash{"123"} already is a reference, then we can just add + the new # key to it. # Note that the name '$value' is a little misleading here, sin +ce we'll # be using it as a key... Well, such is life. $hash{$key}->{$value} = undef; } elsif (exists $hash{$key}) { # $hash{"123"} is already there, but we got another value for +it. # So we need a hash ref. Let's make one. $hash{$key} = {$hash{$key} => undef, $value => undef}; } else { # $hash{"123"} isn't there yet, so here we go rather plainly: $hash{$key} = $value; } } close $fileOne; # Let's see what we've got so far. pp \%hash; # print Dumper \%hash; # Again, I prefer pp, but there are always + multiple options. # Fine then. Let's read that other file. open my $fileTwo, "<", \$setTwo or die "Couldn't read set two: $!"; while (my $line = <$fileTwo>) { chomp $line; my ($newvalue, $key, $oldvalue) = $line =~ m/^(.+)\s+==>\s+(.+)->( +.+)$/; if (ref $hash{$key}) { # If $hash{"123"} is a reference... if (ref $hash{$key}->{$oldvalue}) { # If $hash{"123"}->{"abc"} is also a reference # Jump right to the next iteration if we've run into a dup +licate. # Since your original example didn't specify that it shoul +d take # duplicates into account. next if grep {$_ eq $newvalue} @{$hash{$key}->{$oldvalue}} +; push @{$hash{$key}->{$oldvalue}}, $newvalue; } elsif (exists $hash{$key}->{$oldvalue}) { # $hash{"123"}->{"abc"} is not a reference, even though # it already exists. if (defined $hash{$key}->{$oldvalue}) { # This means that $hash{"123"}->{"abc"} already has a +value, # so what we really need here is to convert it into an + array ref # so that it can hold multiple values. $hash{$key}->{$oldvalue} = [$hash{$key}->{$oldvalue}, +$newvalue]; } else { # $hash{"123"}->{"abc"} is undef, so we can simply rep +lace # the undef with the new value. $hash{$key}->{$oldvalue} = $newvalue; } } } else { # $hash{"123"} is not a reference yet. Let's turn it into one. $hash{$key} = {$oldvalue => $newvalue}; } } close $fileTwo; # Final results: pp \%hash;

But really, this is such a mess that I doubt this is what you want.

Replies are listed 'Best First'.
Re^4: (another) HoH question
by zuma53 (Beadle) on Jun 23, 2012 at 19:52 UTC
    Actually, this does come close to what I was looking for. Understanding it, however, is another matter. LOL.

    I will give it a try.

    Thanks for your help, everyone.

      That's okay. Which part(s) do you find hard to understand? I'd love to explain things in more depth. I could write an elaborate essay of the whole routine, but I'd rather just clarify those parts that are unclear to you. And by "part" I don't necesserily mean pieces of the code - you might as well wonder how or why certain things were done.

        Actually I got it to work! The structure and your comments made it very easy to follow. Thanks a bunch.

        The only quirk that I ran into was that the bottom tier of the hash was a list instead of a hash entry. I had wanted to use a hash if only to squirrel away a data value upon retrieval. As a workaround, I just created a separate HoH for that purpose. (Now that I think about it, I could have created an array for this).

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://978005]
[Corion]: Mhhmmm - https://sod.pixlab .io/ looks really interesting for embedding with Perl (XS), but they don't have any kind of free model available and the cheapest pretrained model costs EUR 40 :-(
[Corion]: Maybe I should mail them to find out if they can provide me a "hotdog / no hotdog" model for developping the XS bindings. It would be nice to have a self-contained XS library for applying models to data. Or maybe I should look at TensorFlow, which can...
[Corion]: ... at least be trained by me, instead of relying on a vendor
[Discipulus]: complex and interesting
[Corion]: Discipulus: My hope would be that you can install the module from CPAN, download a model, and get image descriptions/ object detection within half a day, which would be great :)

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (8)
As of 2018-06-18 10:49 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (109 votes). Check out past polls.