I'm dealing with hashes like:
my %hash1 = (
key1 => 0,
key2 => 1,
key3 => 0,
);
I want to do something if the value of all values (not just one value) of %hash1 is 1.
How to write that?
For reference, I can write:
for $key ( keys %hash1 ) {
if ( $hash1{$key} == 1 ){
#do something
}
}
which is wrong because even if one key has a value equal to 1, the #do something part of the code will run. The code I wrote apparently does something if at least one key equals 1. It would be nice to have something like:
for $key ( keys %hash1 ) {
if ( exists( $hash1{$key} == 1 ) ){
#do something
}
}
I'd do:
my $not_all_ones = grep { $_ != 1 } values %hash1;
You can use List::MoreUtils:
use List::MoreUtils qw/all/;
if (all { $_ == 1 } values %hash) {
# iterate the hash
while (my ($k, $v) = each %hash) {
...
}
}
The all { something($_) } #list is a fancy way of writing
!grep { !something($_) } #list
which uses De Morgan's Law.
Note that my %hash = { key => 1 } does not create the data structure you wanted. Rather, this maps a key "HASH(0x1234567)" to undef. If you use warnings, you'll get a message telling you that you are using a (hash) reference where a list was expected. Initialize hashes with a key-value list: my %hash = ( key => 1).
Set a flag within the if and check its value after the loop.
$all_are_one = $all_are_one && $hash1{$key} == 1
You would need to set it to true before the loop
Related
I have an hash map like this
my $name = 'AUS'; #dynamic values
my %hash = { 'a'=>{
'x'=> {
'1' =>'US'
'2' =>'UK'
}
'y'=>{
'1' =>'AFRICA'
'2' =>'AUS'
}
}
'b'=>{
'x' =>{
'1' =>'US'
'2' =>'UK'
}
}
};
I am trying to find whether name is unique in the hash for each column
foreach my $key(keys %hash)
{
if($name ne $hash{}{}{}) #is name unique in whole hash?
{
print "something";
}
else
{
print "nothing";
}
}
All is fine but when it comes to key 'b' it checks that AUS is not present and prints "something" but I want it to check the 'a' key too to see if has 'AUS' value. So,how to check whether $name exists in whole hash (i can't use find via key-value pair since i am trying to find and print in each column) ?
There's no magic bullet here. You have to traverse your hash and inspect each value. There's a variety of approaches to doing this, and which you use is rather dependent on how your hash-source gets populated.
A recursive solution would be:
#!/usr/bin/env perl
use strict;
use warnings;
my $name = 'AUS';
use Data::Dumper;
my %hash = ( 'a'=>{
'x'=> {
'1' =>'US',
'2' =>'UK'
},
'y'=>{
'1' =>'AFRICA',
'2' =>'AUS'
}
},
'b'=>{
'x' =>{
'1' =>'US',
'2' =>'UK'
}
}
);
my %count_of;
sub traverse {
my ( $input_hash ) = #_;
foreach my $sub ( values %{$input_hash} ) {
if (ref $sub) {
traverse ($sub);
}
else {
$count_of{$sub}++;
}
}
}
traverse (\%hash);
print Dumper \%count_of;
print "$name is unique\n" if $count_of{$name} == 1;
Because this is recursive, it will walk to any 'depth' of the hash, but that might not be entirely appropriate for you use-case.
However the fact that you're talking about columns, suggests to me that this hash is being populated from elsewhere - I would suggest you look at that population process, because it's quite likely that's a better place to start picking out particular counts-of-values.
If you need a more versatile lookup table:
my #unique_elements = grep { $count_of{$_} == 1 } sort keys %count_of;
print Dumper \#unique_elements;
my %is_unique = map { $_ => 1 } #unique_elements;
print Dumper \%is_unique;
print "$name is unique\n" if $is_unique{$name};
if I understand correctly you want something like this:
use strict;
use warnings;
my $name = 'AUS'; #dynamic values
my %hash = ( 'a'=>{
'x'=> {
'1' =>'US',
'2' =>'UK'
},
'y'=>{
'1' =>'AFRICA',
'2' =>'AUS'
}
},
'b'=>{
'x' =>{
'1' =>'US',
'2' =>'UK'
}
}
);
my #val = grep {$_ eq $name} map {my $x=$_; map {my $y=$_; map {$hash{$x}->{$y}->{$_}} keys %{$hash{$x}->{$_}}} keys %{$hash{$_}}} keys %hash;
if(#val == 0) {
print "$name not found";
}
elsif(#val == 1) {
print "$name is unique";
}
else {
print "$name is not unique";
}
A program reads a very large dictionary-style TXT file into a hash. Sometimes, there is a lower case version of a key that is preferable. My solution below is clumsy because it searches twice even if we already know the lc version exists:
if ( exists $hash{ lc $key } ) {
$key = lc $key;
}
if ( exists $hash{ $key } ) {
# lot of code involving $key
}
else {
# the key doesn't exist, other code
}
Is there a way to avoid two exists tests? If lc $key exists I want to do the identical code to it as in the second if but I need to know which version, lc or not, of $key to use. I'm hoping to condense it to one if-else pair.
Knowing the case of the valid key is important for the rest of the program since it is used to look up information in another hash.
if ( my ($real_key) = grep { exists($hash{$_}) } lc($key), $key ) {
...
} else {
...
}
or
my $real_key =
exists($hash{ lc($key) }) ? lc($key)
: exists($hash{ $key }) ? $key
: undef;
if (defined($real_key)) {
...
} else {
...
}
Sure, it still searches twice, but so what? You could use List::Utils's first, but I think replacing a hash lookup with a sub call could actually slow down the code!
You could use first from List::Util. It will return the first list element where the result from the code block is a true value, or undef if the block never returns true.
use List::Util qw(first);
$key = first { exists($hash{$_}) } lc($key), $key;
if (defined($key)) {
# ...
}
You could also do this:
$key = do { my $temp = lc $key; exists $hash{$temp} ? $temp
: ( exists $hash{$key} ? $key : undef) };
if ( defined $key ) {
# lot of code involving $key
}
else {
# the key doesn't exist, other code
}
I'd like to iterate over a hash ref and get keys if they exist, but the keys that I want are at the second level of the hash ref. I want to be able to get to this key for all first level keys of the hash ref that have it
Example:
my $total = 0;
foreach my $student (keys $students) {
if ( exists $student->{???}->{points} ) {
$total += $student->{points};
}
}
return $total;
The problem I've run into is that I want to "not care" what the value of $student->{???} is, just want to get to the {points} for it
You're mixing up your $students variable with your $student variable:
if ( exists $student->{???}->{points} ) {
^^^^^^^^
Should be $students
However, if you don't care about the keys of your first level HoH, then simply don't iterate on them.
Just iterate on the values instead:
use strict;
use warnings;
use List::Util qw(sum);
my $students = {
bob => { points => 17 },
amy => { points => 12 },
foo => { info => 'none' },
bar => { points => 13 },
};
my $total = sum map { $_->{points} // 0 } values %$students;
print "$total is the answer\n";
Outputs:
42 is the answer
I have a data structure like this:
#!/usr/bin/perl -w
my $hash = {
'abTcells' => {
'mesenteric_lymph_node' => {
'Itm2a' => '664.661',
'Gm16452' => '18.1425',
'Sergef' => '142.8205'
},
'spleen' => {
'Itm2a' => '58.07155',
'Dhx9' => '815.2795',
'Ssu72' => '292.889'
}
}
};
What I want to do is to print it out into this format:
mesenteric_lymph_node spleen
Itm2a 664.661 58.07155
Gm16452 18.1425 NA
Sergef 142.8205 NA
Dhx9 NA 815.2795
Ssu72 NA 292.889
What's the way to do it.
I'm currently stuck with the following code https://eval.in/44207
foreach my $ct (keys %{$hash}) {
print "$ct\n\n";
my %hash2 = %{$hash->{$ct}};
foreach my $ts (keys %hash2) {
print "$ts\n";
my %hash3 = %{$hash2{$ts}};
foreach my $gn (keys %hash3) {
print "$gn $hash3{$gn}\n";
}
}
}
Use Text::Table for output. Beautify to taste.
#!/usr/bin/env perl
use strict;
use warnings;
use Text::Table;
my $hash = {
'abTcells' => {
'mesenteric_lymph_node' => {
'Itm2a' => '664.661',
'Gm16452' => '18.1425',
'Sergef' => '142.8205'
},
'spleen' => {
'Itm2a' => '58.07155',
'Dhx9' => '815.2795',
'Ssu72' => '292.889'
}
}
};
my $struct = $hash->{abTcells};
my #cols = sort keys %{ $struct };
my #rows = sort keys %{ { map {
my $x = $_;
map { $_ => undef }
keys %{ $struct->{$x} }
} #cols } };
my $tb = Text::Table->new('', #cols);
for my $r (#rows) {
$tb->add($r, map $struct->{$_}{$r} // 'NA', #cols);
}
print $tb;
Output:
mesenteric_lymph_node spleen
Dhx9 NA 815.2795
Gm16452 18.1425 NA
Itm2a 664.661 58.07155
Sergef 142.8205 NA
Ssu72 NA 292.889
Now, the order of the rows above is different than the one you show because I wanted it to be consistent. If you know the set of all possible rows, then you can specify another order obviously.
First thing would be to separate out the two hashes:
my %lymph_node = %{ $hash->{abTcells}->{mesenteric_lymph_node} };
my %spleen = %{ $hash->{abTcells}->{spleen} };
Now, you have two separate hashes that contains the data you want.
What we need is a list of all the keys. Let's make a third hash that contains your keys.
my %keys;
map { $keys{$_} = 1; } keys %lymph_node, keys %spleen;
Now, we can go through all your keys and print the value for each of the two hashes. If one of the hashes doesn't have the data, we'll set it to NA:
for my $value ( sort keys %keys ) {
my $spleen_value;
my $lymph_nodes_value;
$spleen_value = exists $spleen{$value} ? $spleen{$value} : "NA";
$lymph_node_value = exists $lymph_node{$value} ? $lymph_node{$value} : "NA";
printf "%-20.20s %-9.5f %-9.5f\n", $key, $lymph_node_value, $spleen_value;
}
The printf statement is a nice way to tabularize data. You'll have to create the headings yourself. The ... ? ... : ... statement is an abbreviated if/then/else If the statement before the ? is true, then the value is the value between the ? and the :. Else, the value is the value after the :.
Both of your inner hashes have the same keys, So do a foreach on one of the hashes to get the key, and then print both.
In Perl, I have a hash of hashes created with a loop similar to the following
my %HoH
for my $i (1..10) {
$HoH{$a}{$b} = $i;
}
$a and $b are variables that do have some value when the HoH gets filled in. After creating the HoH, how can I check if a particular pair ($c, $d) exists in the HoH? The following does not work
if (defined $HoH{$c}{$d}) {...}
because if $c does not exist in HoH already, it will be created as a key without a value.
Writing
if (defined $HoH{$c}{$d}) {...}
will "work" insomuch as it will tell you whether or not $HoH{$c}{$d} has a defined value. The problem is that if $HoH{$c} doesn't already exist it will be created (with an appropriate value) so that $HoH{$c}{$d} can be tested. This process is called "autovivification." It's convenient when setting values, e.g.
my %hoh;
$hoh{a}{b} = 1; # Don't need to set '$hoh{a} = {}' first
but inconvenient when retrieving possibly non-existent values. I wish that Perl was smart enough to only perform autovivification for expressions used as lvalues and short-circuit to return undef for rvalues but, alas, it's not that magical. The autovivification pragma (available on CPAN) adds the functionality to do this.
To avoid autovivification you need to test the intermediate values first:
if (exists $HoH{$c} && defined $HoH{$c}{$d}) {
...
}
use Data::Dumper;
my %HoH;
$HoH{A}{B} = 1;
if(exists $HoH{C} && exists $HoH{C}{D}) {
print "exists\n";
}
print Dumper(\%HoH);
if(exists $HoH{C}{D}) {
print "exists\n";
}
print Dumper(\%HoH);
Output:
$VAR1 = {
'A' => {
'B' => 1
}
};
$VAR1 = {
'A' => {
'B' => 1
},
'C' => {}
};
Autovivification is causing the keys to be created. "exists" in my second example shows this so the first example checks both keys individually.
Several ways:
if ( $HoH{$c} && defined $HoH{$c}{$d} ) {...}
or
if ( defined ${ $HoH{$c} || {} }{$d} ) {...}
or
no autovivification;
if (defined $HoH{$c}{$d}) {...}
or
use Data::Diver;
if ( defined Data::Diver::Dive( \%HoH, $c, $d ) ) {...}
You have to use the exists function
exists EXPR
Given an expression that specifies an
element of a hash, returns true if the
specified element in the hash has ever
been initialized, even if the
corresponding value is undefined.
Note that the EXPR can be arbitrarily
complicated as long as the final
operation is a hash or array key
lookup or subroutine name:
if (exists $ref->{A}->{B}->{$key}) { }
if (exists $hash{A}{B}{$key}) { }
My take:
use List::Util qw<first>;
use Params::Util qw<_HASH>;
sub exists_deep (\[%$]#) {
my $ref = shift;
return unless my $h = _HASH( $ref ) // _HASH( $$ref )
and defined( my $last_key = pop )
;
# Note that this *must* be a hash ref, for anything else to make sense.
return if first { !( $h = _HASH( $h->{ $_ } )) } #_;
return exists $h->{ $last_key };
}
You could also do this recursively. You could also create a descent structure allowing intermediate and even terminal arrayref with just a little additional coding.