I've created a hash of hashes in perl, where this is an example of what the hash ends up looking like:
my %grades;
$grades{"Foo Bar"}{Mathematics} = 97;
$grades{"Foo Bar"}{Literature} = 67;
$grades{"Peti Bar"}{Literature} = 88;
$grades{"Peti Bar"}{Mathematics} = 82;
$grades{"Peti Bar"}{Art} = 99;
and to print the entire hash, I'm using:
foreach my $name (sort keys %grades) {
foreach my $subject (keys %{ $grades{$name} }) {
print "$name, $subject: $grades{$name}{$subject}\n";
}
}
I need to print just the inner hash referring to "Peti Bar" and find the highest value, so theoretically, I should just parse through Peti Bar, Literature; Peti Bar, Mathematics; and Peti Bar, Art and end up returning Art, since it has the highest value.
Is there a way to do this or do I need to parse through the entire 2d hash?
You don't need to parse through the first level if you know the key that you're interested. Just leave out the first loop and access it directly. To get the highest value, you have to look at each subject once.
Keep track of the highest value and the key that goes with it, and then print.
my $max_value = 0;
my $max_key;
foreach my $subject (keys %{ $grades{'Peti Bar'} }) {
if ($grades{'Peti Bar'}{$subject} > $max_value){
$max_value = $grades{'Peti Bar'}{$subject};
$max_key = $subject;
}
}
print $max_key;
This will output
Art
An alternative implementation with sort would look like this:
print +(
sort { $grades{'Peti Bar'}{$b} <=> $grades{'Peti Bar'}{$a} }
keys %{ $grades{'Peti Bar'} }
)[0];
The + in +( ... ) tells Perl that the parenthesis () are not meant for the function call to print, but to construct a list. The sort sorts on the keys, descending, because it has $b first. It returns a list, and we take the first value (index 0).
Note that this is more expensive than the first implementation, and not necessarily more concise. Unless you're building a one-liner or your ; is broken I wouldn't recommend the second solution.
This is trivial using the List::UtilsBy module
The code is made clearer by extracting a reference to the inner hash that we're interested in. The max_by is called to return the keys of that hash that has the maximum value
use strict;
use warnings 'all';
use feature 'say';
use List::UtilsBy 'max_by';
my %grades = (
'Foo Bar' => { Literature => 67, Mathematics => 97 },
'Peti Bar' => { Literature => 88, Mathematics => 82, Art => 99 },
);
my $pb_grades = $grades{'Peti Bar'};
say max_by { $pb_grades->{$_} } keys %$pb_grades;
output
Art
As a Perl beginner I would use the List::Util core module:
use 5.014;
use List::Util 'reduce';
my $k='Peti Bar';
say reduce { $grades{$k}{$a} > $grades{$k}{$b} ? $a : $b } keys %{$grades{$k}};
Related
I have a partially nested hash like the following:
$href = {one=>1, word_counts=>{"the"=>34, "train"=>4} };
and I would like to get the value of $href->{'word_counts'}{'train'}.
Is it possible to put the {'word_counts'}{'train'} into a variable, so I can access it by simply calling $href->$variable?
No, but you can use Data::Diver to get a value given a list of keys:
my #keys = ('word_counts', 'train');
my $value = Data::Diver::Dive($href, \(#keys));
There are various ways to do this. I don't think you need to involved $href once you have a shortcut to the value that you want.
You can take a reference to the value, but then you have to dereference it:
my $value_ref = \ $href->{'word_counts'}{'train'};
say $$value_ref;
There's an experimental refaliasing feature where both sides are a reference. Now you don't need to dereference:
use v5.22;
\ my $value_ref = \ $href->{'word_counts'}{'train'};
say $value_ref; # 4
$value_ref = 17;
say $href->{'word_counts'}{'train'}; # 17
It's not hard to walk the hash yourself. The trick is to get one level of the hash, store it in a variable, then use that variable to get the next level. Keep going until you are where you want to be:
my $href = {
one => 1,
word_counts => {
"the" => {
"dog" => 45,
"cat" => 24,
},
"train" => {
"car" => 7,
"wreck" => 37,
}
}
};
my #keys = qw( word_counts train car );
my $temp = $href;
foreach my $key ( #keys ) {
die "Not a hash ref at <$key>" unless ref $temp eq ref {};
die "<$key> not in the hash" unless exists $temp->{$key};
$temp = $temp->{$key};
}
print "Value is <$temp>"; # 7
In addition to the more general, excellent answers from ysth and brian d foy, consider also a very simple (perhaps too simple) solution:
my #keys = qw( word_counts train);
print $href->{ $keys[0] }{ $keys[1] }; # 4
Note that this solution is repetitive, not elegant (the order of keys is hardcoded), and does not try to walk the hash. But depending on the context and the specific task of the OP, this may be all that is needed.
I'm dealing with a hash table in perl.
I have a multiple strings, with multiple lenghts and multiple -:
pre1-pre2-text1-text2
pre3-text3
pre4-pre5-pre6-text4
I have a %hash with the following keys:
pre1-pre2
pre3
pre4-pre5-pre6
So the keys %hash only contain the pre part of the strings.
How can I check if there is a match between let's say the first string pre1-pre2-text1-text2 and the keys of %hash?
One way: form a pattern using alternation of keys, and test strings against it
use warnings;
use strict;
use feature 'say';
my #strings = qw(pre-not pre1-pre2-text1-text2 pre3-text3 pre4-pre5-pre6-text4);
my %h = ( 'pre1-pre2' => 1, 'pre3' => 1, 'pre4-pre5-pre6' => 1 );
my $keys_re = join '|', map { quotemeta } keys %h;
foreach my $str (#strings) {
say $str if $str =~ /$keys_re/;
}
This has quadratic complexity, but alternation won't go through all keys and it's C (regex itself).
A possible improvement (or a necessity!) may be to suitably sort keys. For example, shortest first
my $keys_re = join '|', map { quotemeta } sort { length $a <=> length $b } keys %h;
This may help if there are keys with common parts, but note that it may be a non-trivial adjustment which can affect correctness -- and which may be needed; consider carefully.
To also get the key itself add the capturing parenthesis around the pattern
foreach my $str (#strings) {
say "$str matched by key: $1" if $str =~ /($keys_re)/;
}
where $1 contains the alternation that matched and was captured, which is the key.
I added the inputs given by you in small perl code and i am able to check whether there is a match in keys
#!/usr/bin/perl
use warnings;
my %langs = ( "pre1-pre2" => 'pre1-pre2',
"pre3" => 'pre3',
"pre4-pre5-pre6" => 'pre4-pre5-pre6');
#pats=("pre1-pre2-text1-text2", "pre3-text3", "pre4-pre5-pre6-text4");
for(keys %langs){
foreach $ss (#pats){
if (index($ss,$_) != -1){
print("Key contains:",$_, "|", $ss,"\n");
}
else{
print("NOT FOUND:",$_, "|", $ss,"\n");
}
}
}
NOTE: If i have understood your requirement rightly then this will help you.
This answer supposes that pre cannot occure in the middle of the string (ie, you won't have a string like pre1-pre2-text1-pre5 where your prefix would only be pre1-pre2). If this assumption isn't valid, then use /^((?:pre\d+)(?:-pre\d+)*)/ instead of /^(.*pre\d+)/ (I prefer the latter because it's more readable, but the former is more precise).
#!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
my %pre = map { $_ => 1 } qw(pre1-pre2 pre3 pre4-pre5-pre6);
while (<DATA>) {
my ($prefix) = /^(.*pre\d+)/;
if ($prefix && exists $pre{$prefix}) {
say "Prefix exists: $prefix";
} else {
say "Prefix doesn't exist: $prefix";
}
}
__DATA__
pre1-pre2-text1-text2
pre3-text3
pre4-pre5-pre6-text4
pre7-pre8-text5
If you could have a line pre1-pre2-text1 where the prefix should be just pre1, then this solution won't work. In that case, you'll have no other choice than to iterate over all the keys of the hash and check if they match the beginning of the string:
while (<DATA>) {
for my $prefix (keys %pre) {
if (/^\Q$prefix/) {
say "Found prefix: $prefix";
last;
}
}
}
However, this is far less efficient, since you need to iterate over all of the hash keys for each line.
Regarding \Q: it ensures that this solution works even if your prefixes contain special regex characters (like + or .). If you prefixes are always just like pre1-pre2, then you can omit \Q.
If you have trouble understanding my %pre = map { $_ => 1 } qw(pre1-pre2 pre3 pre4-pre5-pre6);: it's a concise version of
my %prev = (
'pre1-pre2' => 1,
'pre3' => 1,
'pre4-pre5-pre6' => 1
);
I'm trying to learn the reference function, but I can't figure out a way to put hashes in reference at the same time. I want to write a subroutine that will take two simple hash references as arguments and to check whether these two hashes are equal or not. My code is:
#!/usr/bin/perl
use strict;
use warnings;
use feature qw(say);
my $hash1_r = {ITALY => "ROME",
FRANCE => "PARIS"};
my $hash2_r = {ITALY => "MILAN",
FRANCE => "PARIS"};
my $hash3_r = {ITALY => "ROME"};
my $hash4_r = {SPAIN => "ROME",
FRANCE => "PARIS"};
sub compareHashes(%$hash1, %$hash2){
my $hash1; my $hash2;
for (my $i =0; $i < keys %$hash1; $i++){
say "The first hash:";
say "keys %$hash1\t, values %$hash1";
}
for (my $i =0; $i < keys %$hash2; $i++){
say "The second hash:";
say "keys %$hash2\t, values %$hash2";
}
for (keys %$hash1) {
if (keys %$hash1 ne keys %$hash2){
say "Two above hashes are not equal";
}elsif (my $key1 (keys %$hash1) ne my $key2 (keys %$hash2)){
say "Two above hashes are not equal";
}elsif (%$hash1->{$_} ne %$hash2->{$_}){
say "Two above hashes are not equal";
}else {
say "Two above hashes are equal";
}
}
}
compareHashes (%$hash1_r, %$hash1_r);
compareHashes (%$hash1_r, %$hash2_r);
compareHashes (%$hash1_r, %$hash3_r);
compareHashes (%$hash1_r, %$hash4_r);
However, I got those errors:
Prototype after '%' for main::compareHashes : %$hash1,%$hash2 at compareHashes2.pl line 16.
Illegal character in prototype for main::compareHashes : %$hash1,%$hash2 at compareHashes2.pl line 16.
syntax error at compareHashes2.pl line 30, near "$key1 ("
syntax error at compareHashes2.pl line 32, near "}elsif"
Global symbol "$hash2" requires explicit package name at compareHashes2.pl line 32.
Any solutions? Any help will be greatly appreciated!
I would recommend reading the following excellent perl documentation for the general idea:
perldoc perlreftut
A slight simplification of your code, getting the references to work:
#!/usr/bin/perl
use strict;
use warnings;
use feature qw(say);
# { ... } creates a hash reference, you can pass this to a function directly
my $hash1_r = { ITALY => "ROME", FRANCE => "PARIS" };
my $hash2_r = { ITALY => "MILAN", FRANCE => "PARIS" };
my $hash3_r = { ITALY => "ROME" };
my $hash4_r = { SPAIN => "ROME", FRANCE => "PARIS" };
sub compareHashes {
my ($hash1, $hash2) = #_; # #_ is the default array
# You can just use hash references directly by prepending with a '%' symbol
# when you need the actual hash, such as when using 'keys', 'values', 'each', etc.
# You can access the elements by using an arrow: $hashref->{'key_name'}
say "-"x40;
say "The first hash:";
while ( my ($key, $value) = each %$hash1 ) {
say "$key => $value";
}
say "The second hash:";
while ( my ($key, $value) = each %$hash2 ) {
say "$key => $value";
}
my (#keys1) = keys %$hash1;
my ($nkey1) = scalar #keys1;
my (#keys2) = keys %$hash2;
my ($nkey2) = scalar #keys2;
if ($nkey1 != $nkey2) {
say "=> unequal number of keys: $nkey1 vs $nkey2";
return 0; # False, the hashes are different, we don't need to test any further
}
# Create a new hash using all of the keys from hash1 and hash2
# The effect is to eliminate duplicates, as repeated keys, i.e.
# common to both hash1 and hash2 will just produce one key in %uniq
# You can use the 'uniq' function from List::MoreUtils to achieve
# the same thing.
# In perl, using a hash to eliminate duplicates, or test for set
# membership is a very common idiom.
# The 'map' function iterates over a list and performs the
# operation inside the curly braces {...}, returning all
# of the results.
# For example: map { 2 * $_ } ( 1,2,3 ) # ( 2,4,6 )
# If you assign a list to a hash, it takes pairs of values
# and turns them into key/value pairs
# The '=>' is equivalent to a ',' but makes the intent easier
# to understand
my %uniq = map { $_ => 1 } ( #keys1, #keys2 );
my $nuniqkey = scalar keys %uniq;
if ($nkey1 != $nuniqkey) {
say "=> unequal set of keys";
return 0; # False, the hashes are different, we don't need to test any further
}
# Now test the values
# If we neglected to check for uniqueness in the above block,
# we would run into the situation where hash1 might have a key
# that hash2 doesn't have (and vice-versa). This would trigger a
# 'use of uninitialized value' warning in the comparison operator
for my $key (#keys1) {
my ($value1) = $hash1->{$key};
my ($value2) = $hash2->{$key};
if ($value1 ne $value2) {
say "=> unequal values for key '$key' : $value1 vs $value2";
return 0; # False, the hashes are different, we don't need to test any further
}
}
say "=> equal, yay!";
return 1; # True, the hashes are equal after all!
}
compareHashes($hash1_r, $hash1_r);
compareHashes($hash1_r, $hash2_r);
compareHashes($hash1_r, $hash3_r);
compareHashes($hash1_r, $hash4_r);
You have a good answer that you have already accepted. But for people finding this question in the future, I think it's worth explaining some of the errors you have made.
You start by defining some anonymous hashes. That's fine.
my $hash1_r = {
ITALY => "ROME",
FRANCE => "PARIS"
};
my $hash2_r = {
ITALY => "MILAN",
FRANCE => "PARIS"
};
my $hash3_r = {
ITALY => "ROME"
};
my $hash4_r = {
SPAIN => "ROME",
FRANCE => "PARIS"
};
I'm now going to skip to where you call your subroutine (I'll get back to the subroutine itself soon).
compareHashes (%$hash1_r, %$hash1_r);
compareHashes (%$hash1_r, %$hash2_r);
compareHashes (%$hash1_r, %$hash3_r);
compareHashes (%$hash1_r, %$hash4_r);
One of the most important uses for references is to enable you to pass multiple arrays and hashes into a subroutine without them being flattened into a single array. As you have hash references already, it would make sense to pass those references into the subroutine. But you don't do that. You dereference your hashes which means you send the actual hashes into the subroutine. That means that, for example, your first call passes in the list ('ITALY', 'ROME', 'FRANCE', 'PARIS', 'ITALY', 'MILAN', 'FRANCE', 'PARIS'). And there is no way for the code inside your subroutine to separate that list into two hashes.
Now, let's look at the subroutine itself. You start by defining a prototype for the subroutine. In most cases, prototypes are unnecessary. In many cases, they change the code behaviour in hard-to-understand ways. No Perl expert would recommend using prototypes in this code. And, as your error message says, you get the prototype wrong.
sub compareHashes(%$hash1, %$hash2){
I'm not sure what you were trying to do with this prototype. Perhaps it's not a prototype at all - perhaps it's a function signature (but if it was, you would need to turn the feature on).
On the next line, you declare two variables. Variables that you never give values to.
my $hash1; my $hash2;
There are then two very confused for loops.
for (my $i =0; $i < keys %$hash1; $i++){
say "The first hash:";
say "keys %$hash1\t, values %$hash1";
}
$hash1 has no value. So %$hash1 is zero (the hash has no keys) and the loop isn't executed. But we're not missing much as the loop body just prints the same uninitialised values each time.
And you could simplify your for loop by making it a foreach-style loop.
foreach my $i (0 .. keys %$hash1 - 1) { ... }
Or (given that you don't use $i at all:
foreach (1 .. keys %$hash1) { ... }
After another, equally ineffective, for loop for $hash2, you try to compare your two hashes.
for (keys %$hash1) {
if (keys %$hash1 ne keys %$hash2){
say "Two above hashes are not equal";
}elsif (my $key1 (keys %$hash1) ne my $key2 (keys %$hash2)){
say "Two above hashes are not equal";
}elsif (%$hash1->{$_} ne %$hash2->{$_}){
say "Two above hashes are not equal";
}else {
say "Two above hashes are equal";
}
}
I have no idea at all why this is all in a for loop. but your comparisons do nothing to actually compare the values in the hash. All you are comparing is the number of keys in the hashes (which are always going to be equal here - as your hashes are always empty).
All in all, this is the work who is extremely confused about how hashes, subroutines and references work in Perl. I would urge you to stop what you are doing and take the time to work through a good reference book like Learning Perl followed by Intermediate Perl before you continue down your current route and just confuse yourself more.
Is there a simple way to validate a hash of hash element comparsion ?
I need to validate a Perl hash of hash element $Table{$key1}{$key2}{K1}{Value} compare to all other elements in hash
third key will be k1 to kn and i want comprare those elements and other keys are same
if ($Table{$key1}{$key2}{K1}{Value} eq $Table{$key1}{$key2}{K2}{Value}
eq $Table{$key1}{$key2}{K3}{Value} )
{
#do whatever
}
Something like this may work:
use List::MoreUtils 'all';
my #keys = map "K$_", 1..10;
print "All keys equal"
if all { $Table{$key1}{$key2}{$keys[1]}{Value} eq $Table{$key1}{$key2}{$_}{Value} } #keys;
I would use Data::Dumper to help with a task like this, especially for a more general problem (where the third key is more arbitrary than 'K1'...'Kn'). Use Data::Dumper to stringify the data structures and then compare the strings.
use Data::Dumper;
# this line is needed to assure that hashes with the same keys output
# those keys in the same order.
$Data::Dumper::Sortkeys = 1;
my $string1= Data::Dumper->Dump($Table{$key1}{$key2}{k1});
for ($n=2; exists($Table{$key1}{$key2}{"k$n"}; $n++) {
my $string_n = Data::Dumper->Dump($Table{$key1}{$key2}{"k$n"});
if ($string1 ne $string_n) {
warn "key 'k$n' is different from 'k1'";
}
}
This can be used for the more general case where $Table{$key1}{$key2}{k7}{value} itself contains a complex data structure. When a difference is detected, though, it doesn't give you much help figuring out where that difference is.
A fairly complex structure. You should be looking into using object oriented programming techniques. That would greatly simplify your programming and the handling of these complex structures.
First of all, let's simplify a bit. When you say:
$Table{$key1}{$key2}{k1}{value}
Do you really mean:
my $value = $Table{$key1}->{$key2}->{k1};
or
my $actual_value = $Table{$key1}->{$key2}->{k1}->{Value};
I'm going to assume the first one. If I'm wrong, let me know, and I'll update my answer.
Let's simplify:
my %hash = %{$Table{$key1}->{$key2}};
Now, we're just dealing with a hash. There are two techniques you can use:
Sort the keys of this hash by value, then if two keys have the same value, they will be next to each other in the sorted list, making it easy to detect duplicates. The advantage is that all the duplicate keys would be printed together. The disadvantage is that this is a sort which takes time and resources.
Reverse the hash, so it's keyed by value and the value of that key is the key. If a key already exists, we know the other key has a duplicate value. This is faster than the first technique because no sorting is involved. However, duplicates will be detected, but not printed together.
Here's the first technique:
my %hash = %{$Table{$key1}->{$key2}};
my $previous_value;
my $previous_key;
foreach my $key (sort {$hash{$a} cmp $hash{$b}} keys %hash) {
if (defined $previous_key and $previous_value eq $hash{$key}) {
print "\$hash{$key} is a duplicate of \$hash{$previous_key}\n";
}
$previous_value = $hash{$key};
$previous_key = $key;
}
And the second:
my %hash = %{$Table{$key1}->{$key2}};
my %reverse_hash;
foreach $key (keys %hash) {
my $value = $hash{$key};
if (exists $reverse_hash{$value}) {
print "\$hash{$reverse_hash{$value}} has the same value as \$hash{$key}\n";
}
else {
$reverse_hash{$value} = $key;
}
}
Alternative approach to the problem is make utility function which will compare all keys if has same value returned from some function for all keys:
sub AllSame (&\%) {
my ($c, $h) = #_;
my #k = keys %$h;
my $ref;
$ref = $c->() for $h->{shift #k};
$ref ne $c->() and return for #$h{#k};
return 1
}
print "OK\n" if AllSame {$_->{Value}} %{$Table{$key1}{$key2}};
But if you start thinking in this way you can found this approach much more generic (recommended way):
sub AllSame (#) {
my $ref = shift;
$ref ne $_ and return for #_;
return 1
}
print "OK\n" if AllSame map {$_->{Value}} values %{$Table{$key1}{$key2}};
If mapping operation is expensive you can make lazy counterpart of same:
sub AllSameMap (&#) {
my $c = shift;
my $ref;
$ref = $c->() for shift;
$ref ne $c->() and return for #_;
return 1
}
print "OK\n" if AllSameMap {$_->{Value}} values %{$Table{$key1}{$key2}};
If you want only some subset of keys you can use hash slice syntax e.g.:
print "OK\n" if AllSame map {$_->{Value}} #{$Table{$key1}{$key2}}{map "K$_", 1..10};
Is there a hash equivalent for map?
my %new_hash = hash_map { new_key($a) => new_val($b) } %hash;
I know that I could loop through the keys.
List::Pairwise claims to implement exactly that syntax -- see mapp, grepp. I haven't used it though.
Also, you can do it as
%new_hash = map { new_key($_) => new_value($hash{$_}) } keys %hash;
which I admit looks clumsier if %hash is really a $deeply->{buried}->{hash}. I prefer using $temp = ...; map {...} keys %$temp in such cases.
I really can’t see what you are trying to do here. What does “a hash equivalent for map” even mean? You can use map on a hash just fine. If you want the keys, just use keys; for example"
#msglist = map { "value of $_ is $hash{$_}" } keys %hash
although usually
say "value of $_ is $hash{$_}" keys %hash;
is just fine.
If you want both, then use the whole hash.
For assignment, what’s wrong with %new_hash = %old_hash?
Do you have deep-copy issues? Then use Storable::dclone.
Do you want both key and value available in the closure at the same time? Then make a bunch of pairs with the first map:
#pairlist = map { [ $_ => $hash{$_} ] } keys %hash
I need to see an example of what you would want to do with this, but so far I can see zero cause for using some big old module instead of basic Perl.
You can use map like this:
my $i = 0;
my %new_hash = map { $i ^= 1 ? new_key($_) : new_val($_) } %hash;
You can use mapn from my module List::Gen to do this:
use List::Gen 'mapn';
my %new_hash = mapn {new_key($_[0]) => new_value($_[1])} 2 => %old_hash;
mapn is like map, except it it takes an additional argument, the number of elements to walk the list by. Inside the block, the #_ array is set to the current slice.
$ perl -d /dev/null
DB<2> %p = ( a=>'b', c=> 'd');
DB<5> p Dumper \%p
$VAR1 = {
'c' => 'd',
'a' => 'b'
};
To e.g. reverse the key and the value:
DB<6> %q = map { ($p{$_}, $_ ) } keys %p
DB<7> p Dumper \%q
$VAR1 = {
'b' => 'a',
'd' => 'c'
};
As of perl 5.20, core utility List::Util::pairmap does exactly that:
use List::Util qw(pairmap);
my %new_hash = pairmap { new_key($a) => new_val($b) } %hash;
It's not necessarily optimal (as it involves unrolling the hash to a list and back) but I believe this is the shortest way in vanilla perl.