how to pass hash reference to a subroutine - perl

I'm stuck on a problem. I'm trying to make references for 2 hashes, then compare them in a subroutine. However, there is an error:
Can't use an undefined value as a HASH reference at compareHashes.pl line 10.
My code is:
use strict;
use warnings;
use feature qw(say);
my $hash_1; my $hash_2;
compareHashes($hash_1, $hash_2);
sub compareHashes{
say "the first hash:", "\n", %$hash_1;
say "the second hash:", "\n", %$hash_2;
if ((keys(%$hash_1) eq keys(%$hash_2)) and (values(%$hash_1) eq values(%$hash_2))){
say "Two above hashes are equal";}
else {
say "Two above hashes are not equal";
}
};
my %hash1 = (ITALY => "ROME",
FRANCE => "PARIS"
);
my %hash2 = ( ITALY => "MILAN",
FRANCE => "PARIS"
);
my %hash3 = (ITALY => "ROME" );
my %hash4 = (SPAIN => "ROME",
FRANCE => "PARIS"
);
my $hash1_r = \%hash1;
my $hash2_r = \%hash2;
my $hash3_r = \%hash3;
my $hash4_r = \%hash4;
compareHashes ($hash1_r, $hash1_r);
compareHashes ($hash1_r, $hash2_r);
compareHashes ($hash1_r, $hash3_r);
compareHashes ($hash1_r, $hash4_r);
Please tell me what is wrong. I appreciate your help.

You never assigned to $hash_1 and $hash_2!
my ($hash_1, $hash_2) = #_;
You have more problems than that, however, both keys and values in scalar context return the number of elements in a hash, so you are simply checking if both hashes are of the same size!
sub are_hashes_equal {
my ($hash1, $hash2) = #_;
{
my %set;
++$set{$_} for keys(%$hash1);
--$set{$_} for keys(%$hash2);
return 0 if grep { $_ } values(%set);
}
for my $key (keys(%$hash1)) {
return 0 if $hash1->{$key} ne $hash2->{$key};
}
return 1;
}

Related

Accessing and modifying a nested hash based on a dot separated string

I have a string as input, say apple.mango.orange = 100
I also have a hash reference:
$inst = {
'banana' => 2,
'guava' => 3,
'apple' => {
'mango' => {
'orange' => 80
}
}
};
I want to modify the value of orange using the input string. Can someone please help me how I could do this?
I tried splitting the string into (key, value) pair. I then did the following on the key string:
my $key2 = "\$inst->{".$key."}";
$key2 =~ s/\./}->{/g;
$$key2 = $value;
This does not work as intended. Can someone help me out here? I have read the Perl FAQ about not using a variable value as variable but I am unable to think of an alternative.
You are building string that consists of (buggy) Perl code, but you never ask Perl to execute it. ...but that's not the right approach.
sub dive_val :lvalue {
my $p = \shift;
$p = \($$p->{$_}) for #_;
$$p
}
my #key = split /\./, "apple.mango.orange";
dive_val($inst, #key) = $value;
or
use Data::Diver qw( DiveVal );
my #key = split /\./, "apple.mango.orange";
DiveVal($inst, map \$_, #key) = $value;
Not only is a symbolic reference a very bad idea here, it doesn't even solve your problem. You're building an expression in $key2, and just jamming another dollar sign in front of its name won't make perl execute that code. For that you would need eval, which is another bad idea
You can install and use the Data::Diver module, which does exactly this sort of thing, or you can simply loop over the list of hash keys, picking up a new hash reference each time and assigning the value to the element with the last key
The biggest issue is actually parsing the incoming string into a list of keys and a value. This code implements a subroutine apply which applies the implied operation in the string to a nested hash. Unless you are confident of your data, it needs some error checking addingto make sure each of the keys in the list exists. The Data:;Dumper output is just to demonstrate the validity of the result
use strict;
use warnings 'all';
use Data::Dumper;
my $inst = { 'banana' => 2, 'guava' => 3, 'apple' => { 'mango' => { 'orange' => 80 } } };
my $s = 'apple.mango.orange = 100';
apply($s, $inst);
print Dumper $inst;
sub apply {
my ($operation, $data) = #_;
my ($keys, $val) = $operation =~ /([\w.]+)\s*=\s*(\d+)/;
my #keys = split /\./, $keys;
my $last = pop #keys;
my $hash = $data;
$hash = $hash->{$_} for #keys;
$hash->{$last} = $val;
}
output
$VAR1 = {
'banana' => 2,
'apple' => {
'mango' => {
'orange' => '100'
}
},
'guava' => 3
};

Find key for greatest value in hash of hashes in Perl

I have a hash of hashes containing keys, values, and counts of the form ((k1, v1), c1). I am trying to write a subroutine that returns the value of the key passed as a parameter with the greatest count. For example, if I had:
%hash = (
"a" => {
"b" => 2,
"c" => 1,
},
"d" => {
"e" => 4,
},
);
and made the call:
print &function("a");
it should print "b" because key "a" has the highest count of 2 with "b" as its value. Here is the code I have so far:
sub function() {
$key = $_[0];
if(exists($hash{$key})) {
while (my ($value, $count) = each %{$hash{$key}}) {
#logic goes here
}
} else {
return "$key does not exist";
}
}
The sub doesn't need to know anything about the outer hash, so it makes far more sense to call the sub as follows:
print key_with_highest_val($hash{a});
The sub simply needs to iterate over all the elements of that hash, keeping track of the highest value seen, and the key at which it was seen.
sub key_with_highest_val {
my ($h) = #_;
my $hi_v;
my $hi_k;
for my $k (keys(%$h)) {
my $v = $h->{$k};
if (!defined($hi_v) || $v > $hi_v) {
$hi_v = $v;
$hi_k = $k;
}
}
return $hi_k;
}
As Chris Charley points out, List::Util's reduce can simply this function. With the calling convention I recommended above, the reduce solution becomes the following:
use List::Util qw( reduce );
sub key_with_highest_val {
my ($h) = #_;
return reduce { $h->{$a} >= $h->{$b} ? $a : $b } keys(%$h);
}
Both versions return an arbitrary key among those that tied when there's a tie.
Use the reduce function from List::Util (which is part of core perl).
#!/usr/bin/perl
use strict;
use warnings;
use List::Util qw/reduce/;
my %hash = (
"a" => {
"b" => 2,
"c" => 1,
},
"d" => {
"e" => 4,
},
);
my $key = 'a';
print "For key: $key, max key is ", max_key($key, %hash), "\n";
sub max_key {
my ($key, %hash) = #_;
return "$key does not exist" unless exists $hash{$key};
my $href = $hash{$key};
return reduce { $href->{$a} > $href->{$b} ? $a : $b } keys %$href;
}
You should always include use strict and use warnings at the top of your programs to catch errors so you can find and fix them. This requires declaring of your variables with my, like my $key = 'a';, for example and my %hash = ...
This program prints:
For key: a, max key is b
This code makes the following assumptions:
The values of your nested hashes are always numeric.
You don't have duplicate values.
Anything else is left as an exercise for the reader.
use strict;
use warnings;
use Data::Dump;
use List::Util qw(max);
my %hash = (
a => {
b => 2,
c => 1,
},
d => {
e => 4,
},
);
dd(max_hash_value(\%hash, $_)) for 'a' .. 'd';
sub max_hash_value {
my ($hash_ref, $search_key) = #_;
return unless $hash_ref->{$search_key};
my %lookup;
while (my ($key, $value) = each(%{$hash_ref->{$search_key}})) {
$lookup{$value} = $key;
}
return $lookup{max(keys(%lookup))};
}
Output:
"b"
()
()
"e"

Adding each element in an array to a complex hash in Perl

I have an array with n number of elments. I want to add each of the elements to a complex hash, each as a key/value pair. If the number of elements were fixed, say three, I would do:
my %hash;
my #array = ("first", "second", "third");
$hash{$array[0]}{$array[1]}{$array[2]}++;
The structure I want to end up with, is this (printed with Data::Dumper):
$VAR1 = 'first';
$VAR2 = {
'second' => {
'third' => 1
};
But I am at loss at achieving the same structure when the number of elements in the array isn't fixed. Something with anonymous variables and iterating through the array, yes, but something like foreach #array{$hash{$_}++}; will obviously only make one entry per element, and not the desired structure. Help?
Something like this could build the structure you desire for N elements:
use strict;
use warnings;
use Data::Dumper;
my #array = qw(first second third four five six seven);
my $hash;
foreach my $key ( reverse #array ) {
$hash = { $key => $hash };
}
print Dumper $hash;
__END__
$VAR1 = {
'first' => {
'second' => {
'third' => {
'fourth' => {
'fifth' => {
'sixth' => {
'seventh' => undef
}
}
}
}
}
}
};
It is not clear what you really need this for. There may be a better solution if you explain your use-case a little more. Incrementing this structure doesn't appear to be very easy.
After playing around a little, you can increment by traversing the hash reference to the bottom then incrementing the value of the last element. It is not very pretty though :|
# incrementing
my $elem = $hash; # copy the reference
foreach my $key ( #array ) {
# found the bottom of the hash
unless ( $elem->{$key} && ref($elem->{$key}) ) {
$elem->{$key}++;
last;
}
# not at the bottom, move to the next level
$elem = $elem->{$key};
}
print Dumper $hash;
__END__
$VAR1 = {
'first' => {
'second' => {
'third' => {
'fourth' => {
'fifth' => {
'sixth' => {
'seventh' => 1
}
}
}
}
}
}
};
This is relatively simple if you maintain a current hash reference. This short program demonstrates
The first few steps make sure that each hash element exists and its value is a hash reference. $href is moved to the next level of hash at each stage. For the final element of the array, the latest hash level's element is incremented instead of being set to a hash reference.
Whether or not this data structure is the correct choice depends on what else you need to do with it once you have built it
use strict;
use warnings;
my %hash;
my #array = qw/ first second third fourth fifth /;
drill_hash(\%hash, #array);
use Data::Dump;
dd \%hash;
sub drill_hash {
my ($href, #list) = #_;
my $final = pop #list;
$href = $href->{$_} //= {} for #list;
++$href->{$final};
}
output
{
first => { second => { third => { fourth => { fifth => 1 } } } },
}
Update
Having understood your purpose, the simplest way to keep a count of occurrences of ngrams like that is to have a speficic hash key that is used to keep the count of the sequence of words so far.
This program uses the value _COUNT for that key, and you can see that, for example, {under}{a}{_COUNT} and {under}{a}{rock}{_COUNT} are both 1
use strict;
use warnings;
my %counts;
count_ngram(\%counts, qw/ under a /);
count_ngram(\%counts, qw/ a rock /);
count_ngram(\%counts, qw/ under a rock /);
count_ngram(\%counts, qw/ a tree /);
count_ngram(\%counts, qw/ under a tree /);
use Data::Dump;
dd \%counts;
sub count_ngram {
my ($href, #ngram) = #_;
my $final = pop #ngram;
$href = $href->{$_} //= {} for #ngram;
++$href->{$final}{_COUNT};
}
output
{
a => { rock => { _COUNT => 1 }, tree => { _COUNT => 1 } },
under => {
a => { _COUNT => 1, rock => { _COUNT => 1 }, tree => { _COUNT => 1 } },
},
}

Merging hashes in perl

I am trying to merge two hashes. Well, I am able to merge, but the output is not the way I want it to be:
Here is my code:
my %friend_list = (
Raj => "Good friend",
Rohit => "new Friend",
Sumit => "Best Friend",
Rohini => "Fiend",
Allahabad => "UttarPradesh",
);
my %city = (
Bangalore => "Karnataka",
Indore => "MadhyaPradesh",
Pune => "Maharashtra",
Allahabad => "UP",
);
my %friends_place = ();
my ($k, $v);
foreach my $ref (\%friend_list, \%city) {
while (($k,$v) = each (%$ref)) {
if (exists $ref{$k}) {
print"Warning: Key is all ready there\n";
next;
}
$friends_place{$k} = $v;
}
}
while (($k,$v) = each (%friends_place)) {
print "$k = $v \n";
}
From this o/p is
Raj=Good friend
Indore=MadhyaPradesh
Rohit=new Fiend
Bangalore=Karnataka
Allahabad=UttarPradesh
Sumit=Best Friend
Pune=Maharashtra
Rohini =Fiend
But I want to print %friend_list first followed by %city.
Another thing which I was trying to do is, if there is any duplicate key, then it should give me a warning message. But it is not giving me any message. As we can see here, we have Allahabad in both hash.
Thanks
Try with:
my %firend_list = (
Raj => "Good friend",
Rohit => "new Fiend",
Sumit => "Best Friend",
Rohini => "Fiend",
Allahabad => "UttarPradesh",
);
my %city = (
Bangalore => "Karnataka",
Indore => "MadhyaPradesh",
Pune => "Maharashtra",
Allahabad => "UP",
);
#merging
my %friends_place = ( %friend_list, %city );
And, for warnings:
foreach my $friend( keys %friend_list ){
print"Warning: Key is all ready there\n" if $friend ~~ [ keys %city ];
}
The line if (exists $ref{$k}) { is wrong and you can see it if you're putting use strict; use warnings; at the begining of the script.
Moreover this line should be if (exists $friends_place{$k}) { to produce the message about duplicate keys.
As hashes are unordered, you need to use an array to store the ordering:
my %friends_place = (%firend_list, %city);
my #friends_place_keyorder = ((keys %firend_list), (keys %city));
if ((scalar keys %friends_place) != (scalar #friends_place_keyorder)) {
print 'duplicate key found';
}
foreach (#friends_place_keyorder) {
print "$_ = $friends_place{$_}\n";
}
EDIT: my original solution in python, left here for historical purpose:
As hashes are unordered, you need to use an array to store the ordering. I don't know perl, so the following code is python (should be fairly straightforward to translate to perl):
friend_list = ...
city = ...
friends_place = dict(friend_list.items() + city.items())
friends_place_keyorder = friend_list.keys() + city.keys()
# detect duplicate keys by checking their lengths
# if there is duplicate then the hash would be smaller than the list
if len(friends_place) != len(friends_place_keyorder):
print "duplicate key found"
# iterate through the list of keys instead of the hashes directly
for k in friends_place_keyorder:
print k, friends_place[k]

Equivalent of "shift" for a hash to create a $class->next() method

I almost feel like saying "it's me again!".
Anyway, here we go.
I like using while $object->next() style constructs. They appeal to me and seem "neat".
Now, when the thing I'm iterating over is an array, it's straightforward ("shift #ary or return undef")
sub next {
my ( $self, $args ) = #_;
my $next = shift #{ $self->{list_of_things} } or return undef;
my ( $car, $engine_size, $color )
= split( /\Q$opts->{fieldsep}/, $next );
$self->car = $host;
$self->engine_size = $engine_size;
$self->color = $color;
}
In this example I use AUTOLOAD to create the getters and setters and then have those instance variables available in my object during the while loop.
I'd like to do something similar but with the "list_of_things" being a %hash.
Here's a non-OO example that doesn't make it into the first iteration. Any ideas why?
(The total "list_of_things" is not that big - maybe 100 entries - so to do a keys(%{$hash}) every time doesn't seem too wasteful to me).
use strict;
use warnings;
use Data::Dumper;
my $list_of_things = {
volvo => {
color => "red",
engine_size => 2000,
},
bmw => {
color => "black",
engine_size => 2500,
},
mini => {
color => "british racing green",
engine_size => 1200,
}
};
sub next {
my $args = $_;
my #list = keys( %{$list_of_things} );
return undef if scalar #list == "0";
my $next = $list_of_things->{ $list[0] };
delete $list_of_things->{ $list[0] };
return $next;
}
while ( next()) {
print Dumper $_;
print scalar keys %{ $list_of_things }
}
Is there a better way of doing this? Am I doing something crazy?
EDIT:
I tried Ikegami's suggestion. Of course, Ikegami's example works flawlessly. When I try and abstract a little, so that all that is exposed to the object is a next->() method, I get the same "perl-going-to-100%-cpu" problem as in my original example.
Here's a non-OO example:
use Data::Dumper qw( Dumper );
sub make_list_iter {
my #list = #_;
return sub { #list ? shift(#list) : () };
}
sub next {
make_list_iter( keys %$hash );
}
my $hash = { ... };
while ( my ($k) = next->() ) {
print Dumper $hash->{$k};
}
It does not seem to get past the first step of the while() loop.
I am obviously missing something here...
If you don't want to rely on the hash's builtin iterator (used by each, keys and values), there's nothing stopping you from making your own.
use Data::Dumper qw( Dumper );
sub make_list_iter {
my #list = #_;
return sub { #list ? shift(#list) : () };
}
my $list_of_things = { ... };
my $i = make_list_iter(keys %$list_of_things);
while (my ($k) = $i->()) {
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Indent = 0;
say "$k: " . Dumper($list_of_things->{$k});
}
The each operator is a builtin that iterates over hashes. It returns undef when it runs out of elements to return. So you could so something like
package SomeObject;
# creates new object instance
sub new {
my $class = shift;
return bless { hash_of_things => { #_ } }, $class
}
sub next {
my $self = shift;
my ($key,$value) = each %{ $self->{hash_of_things} };
return $key; # or return $value
}
Calling keys on the hash will reset the each iterator. It's good to know this so you can reset it on purpose:
sub reset {
my $self = shift;
keys %{ $self->{hash_of_things} }
}
and so you can avoid resetting it on accident.
The section on tie'ing hashes in perltie also has an example like this.
Here's how List::Gen could be used to create an iterator from a list:
use strict;
use warnings;
use List::Gen 'makegen';
my #list_of_things = ( # This structure is more suitable IMO
{
make => 'volvo',
color => 'red',
engine_size => 2000,
},
{
make => 'bmw',
color => 'black',
engine_size => 2500,
},
{
make => 'mini',
color => 'british racing green',
engine_size => 1200,
}
);
my $cars = makegen #list_of_things;
print $_->{make}, "\n" while $cars->next;
Well, if you don't need $list_of_things for later, you can always do something like
while(keys %$list_of_things)
{
my $temp=(sort keys %$list_of_things)[0];
print "key: $temp, value array: " . join(",",#{$list_of_things->{$temp}}) . "\n";
delete $list_of_things->{$temp};
}
And if you do need it, you can always assign it to a temporary hash reference and perform the same while loop on it.