Search through hash, if value is zero delete it - perl

I have some code as follows. I am trying to search through the hash and if I come across a value that is zero, I want to delete the whole key/value element.
my %hashy = (
a => my $a,
b => my $b,
c => my $c,
d => my $d,
e => my $e
);
$hashy{'a'} = 0;
$hashy{'b'} = 1;
$hashy{'c'} = 0;
$hashy{'d'} = 2;
$hashy{'e'} = 1;
my #keys = keys %hashy;
my #values = values %hashy;
my $ind = 0;
foreach my $v (#values) {
delete $hashy{$keys[$ind]} if ($v == 0);
}
So the expected output of printing %hashy would be: b1d2e1 (ignoring order of elements)
At the moment I get: c0a0b1d2 which isn't even close... any help would be appreciated :)

Iterating over the values won't help because you lose the association between the values and the keys, although I guess that's what $ind was supposed to be helping you track.
Just iterate over the keys instead:
foreach my $k (keys %hashy) {
delete $hashy{$k} if ($hashy{$k} == 0);
}

Another way to do it:
delete #hash{ grep $hash{$_} == 0, keys %hash };

Related

Regarding complex hashes in perl

I have a hash of hash, where my first key is name and second is some classes like level A, level B, level C and the values is d total number of students..
%hash{name}->{class}->number
So I fill my hash and everything is done but now when I print I get the number but if suppose a student name is in level A and level C and not in level B it should show
Name:level A = 1
level B = 0
level C = 1
How can I get my result like this? Please help me out..
use strict;
use warnings;
my %scores = (
homer => { levA => 1, levC => 2 },
bart => { levA => 3, levB => 4 },
);
my %all_levels = map { map {$_ => 1} keys %$_ } values %scores;
for my $h (values %scores){
for my $lev (keys %all_levels){
$h->{$lev} = 0 unless exists $h->{$lev};
}
}
This is a bit of a stretch, but what I think you're after is to assign a value of zero to all (name,class) pairs for which $hash{name}->{class} is undefined. So, given that...
my #classes; #First, we grab all of the possible classes.
foreach my $name (sort keys %hash)
{
foreach my $class (sort keys %{$hash->{$name}})
{
push #classes, $class unless $class~~#classes;
}
}
#classes=sort #classes #or sort{$a<=>$b}#classes, depending on the datatype...
foreach my $name(sort keys %hash)
{
foreach my $class(#classes)
{
$hash->{$name}->{$class}=0 unless defined $hash->{$name}->{$class};
}
}

Inverting a Hash's Key and Values in Perl

I would like to make the value the key, and the key the value. What is the best way to go about doing this?
Adapted from http://www.dreamincode.net/forums/topic/46400-swap-hash-values/:
Assuming your hash is stored in $hash:
while (($key, $value) = each %hash) {
$hash2{$value}=$key;
}
%hash=%hash2;
Seems like much more elegant solution can be achieved with reverse (http://www.misc-perl-info.com/perl-hashes.html#reverseph):
%nhash = reverse %hash;
Note that with reverse, duplicate values will be overwritten.
Use reverse:
use Data::Dumper;
my %hash = ('month', 'may', 'year', '2011');
print Dumper \%hash;
%hash = reverse %hash;
print Dumper \%hash;
As mentioned, the simplest is
my %inverse = reverse %original;
It "fails" if multiple elements have the same value. You could create an HoA to handle that situation.
my %inverse;
push #{ $inverse{ $original{$_} } }, $_ for keys %original;
So you want reverse keys & vals in a hash? So use reverse... ;)
%hash2 = reverse %hash;
reverting (k1 => v1, k2 => v2) - yield (v2=>k2, v1=>k1) - and that is what you want. ;)
my %orig_hash = (...);
my %new_hash;
%new_hash = map { $orig_hash{$_} => $_ } keys(%orig_hash);
The map-over-keys solution is more flexible. What if your value is not a simple value?
my %forward;
my %reverse;
#forward is built such that each key maps to a value that is a hash ref:
#{ a => 'something', b=> 'something else'}
%reverse = map { join(',', #{$_}{qw(a b)}) => $_ } keys %forward;
Here is a way to do it using Hash::MultiValue.
use experimental qw(postderef);
sub invert {
use Hash::MultiValue;
my $mvh = Hash::MultiValue->from_mixed(shift);
my $inverted;
$mvh->each( sub { push $inverted->{ $_[1] }->#* , $_[0] } ) ;
return $inverted;
}
To test this we can try the following:
my %test_hash = (
q => [qw/1 2 3 4/],
w => [qw/4 6 5 7/],
e => ["8"],
r => ["9"],
t => ["10"],
y => ["11"],
);
my $wow = invert(\%test_hash);
my $wow2 = invert($wow);
use DDP;
print "\n \%test_hash:\n\n" ;
p %test_hash;
print "\n \%test_hash inverted as:\n\n" ;
p $wow ;
# We need to sort the contents of the multi-value array reference
# for the is_deeply() comparison:
map {
$test_hash{$_} = [ sort { $a cmp $b || $a <=> $b } #{ $test_hash{$_} } ]
} keys %test_hash ;
map {
$wow2->{$_} = [ sort { $a cmp $b || $a <=> $b } #{ $wow2->{$_} } ]
} keys %$wow2 ;
use Test::More ;
is_deeply(\%test_hash, $wow2, "double inverted hash == original");
done_testing;
Addendum
Note that in order to pass the gimmicky test here, the invert() function relies on %test_hash having array references as values. To work around this if your hash values are not array references, you can "coerce" the regular/mixed hash into a multi-value hash thatHash::MultiValue can then bless into an object. However, this approach means even single values will appear as array references:
for ( keys %test_hash ) {
if ( ref $test_hash{$_} ne 'ARRAY' ) {
$test_hash{$_} = [ $test_hash{$_} ]
}
}
which is longhand for:
ref($_) or $_ = [ $_ ] for values %test_hash ;
This would only be needed to get the "round trip" test to pass.
Assuming all your values are simple and unique strings, here is one more easy way to do it.
%hash = ( ... );
#newhash{values %hash} = (keys %hash);
This is called a hash slice. Since you're using %newhash to produce a list of keys, you change the % to a #.
Unlike the reverse() method, this will insert the new keys and values in the same order as they were in the original hash. keys and values always return their values in the same order (as does each).
If you need more control over it, like sorting it so that duplicate values get the desired key, use two hash slices.
%hash = ( ... );
#newhash{ #hash{sort keys %hash} } = (sort keys %hash);

Tie::IxHash ordered associative arrays in Hash of Hashes?

How can I preserve the order in which the hash elements were added
FOR THE SECOND VAR ?
( Hash of Hashes )
For example:
use Tie::IxHash;
my %hash;
tie %hash, "Tie::IxHash";
for my $num (0 .. 5){
$hash{"FirstVal$num"}++;
}
for my $num (0 .. 5){
$hash{"FirstValFIXED"}{"SecondVal$num"}++;
}
print Dumper(%hash);
When dumping out the result, $VAR14 didn't preserve the insertion order:
$VAR1 = 'FirstVal0';
$VAR2 = 1;
$VAR3 = 'FirstVal1';
$VAR4 = 1;
$VAR5 = 'FirstVal2';
$VAR6 = 1;
$VAR7 = 'FirstVal3';
$VAR8 = 1;
$VAR9 = 'FirstVal4';
$VAR10 = 1;
$VAR11 = 'FirstVal5';
$VAR12 = 1;
$VAR13 = 'FirstValFIXED';
$VAR14 = {
'SecondVal5' => 1,
'SecondVal4' => 1,
'SecondVal2' => 1,
'SecondVal1' => 1,
'SecondVal3' => 1,
'SecondVal0' => 1
};
I know I can trick that example with some sort operation but in my real problem the elements are not numbered or can't be ordered some how.
Is there any simple function/operation for hash multi level order insertion ?
Thanks,
Yodar.
Look at Tie::Autotie. It automatically ties new hashes created by autovivification. The perldoc page shows an example using Tie::IxHash.
You need an extra "\", as below.
print Dumper(\%hash);
Do you mean hash of hashes? You need to tie to Tie::IxHash every value of outer hash.
use strict;
use warnings;
use Tie::IxHash;
my $hash={};
my $t = tie(%$hash, 'Tie::IxHash', 'a' => 1, 'b' => 2);
%$hash = (first => 1, second => 2, third => 3);
$hash->{fourth} = 4;
print join(', ',keys %$hash),"\n";
my %new_hash=('test'=>$hash);
$new_hash{'test'}{fifth} = 5;
print join(', ',keys %{$new_hash{'test'}}),"\n";
$new_hash{'test'}{fifth}++;
print join(', ',values %{$new_hash{'test'}}),"\n";
foreach my $sortline (sort {$a<=>$b} keys %{$hash->{"first_field"}}){
my $name;
# Soultion to touch a Key with keys within it:
#---------------------------------------------
foreach my $subkey (keys %{$hash->{"first_field"}->{$sortline}})
{$name = $subkey;}
#---------------------------------------------
}
This useful answer helped me.

Difference of Two Arrays Using Perl

I have two arrays. I need to check and see if the elements of one appear in the other one.
Is there a more efficient way to do it than nested loops? I have a few thousand elements in each and need to run the program frequently.
Another way to do it is to use Array::Utils
use Array::Utils qw(:all);
my #a = qw( a b c d );
my #b = qw( c d e f );
# symmetric difference
my #diff = array_diff(#a, #b);
# intersection
my #isect = intersect(#a, #b);
# unique union
my #unique = unique(#a, #b);
# check if arrays contain same members
if ( !array_diff(#a, #b) ) {
# do something
}
# get items from array #a that are not in array #b
my #minus = array_minus( #a, #b );
perlfaq4 to the rescue:
How do I compute the difference of two arrays? How do I compute the intersection of two arrays?
Use a hash. Here's code to do both and more. It assumes that each element is unique in a given array:
#union = #intersection = #difference = ();
%count = ();
foreach $element (#array1, #array2) { $count{$element}++ }
foreach $element (keys %count) {
push #union, $element;
push #{ $count{$element} > 1 ? \#intersection : \#difference }, $element;
}
If you properly declare your variables, the code looks more like the following:
my %count;
for my $element (#array1, #array2) { $count{$element}++ }
my ( #union, #intersection, #difference );
for my $element (keys %count) {
push #union, $element;
push #{ $count{$element} > 1 ? \#intersection : \#difference }, $element;
}
You need to provide a lot more context. There are more efficient ways of doing that ranging from:
Go outside of Perl and use shell (sort + comm)
map one array into a Perl hash and then loop over the other one checking hash membership. This has linear complexity ("M+N" - basically loop over each array once) as opposed to nested loop which has "M*N" complexity)
Example:
my %second = map {$_=>1} #second;
my #only_in_first = grep { !$second{$_} } #first;
# use a foreach loop with `last` instead of "grep"
# if you only want yes/no answer instead of full list
Use a Perl module that does the last bullet point for you (List::Compare was mentioned in comments)
Do it based on timestamps of when elements were added if the volume is very large and you need to re-compare often. A few thousand elements is not really big enough, but I recently had to diff 100k sized lists.
You can try Arrays::Utils, and it makes it look nice and simple, but it's not doing any powerful magic on the back end. Here's the array_diffs code:
sub array_diff(\#\#) {
my %e = map { $_ => undef } #{$_[1]};
return #{[ ( grep { (exists $e{$_}) ? ( delete $e{$_} ) : ( 1 ) } #{ $_[0] } ), keys %e ] };
}
Since Arrays::Utils isn't a standard module, you need to ask yourself if it's worth the effort to install and maintain this module. Otherwise, it's pretty close to DVK's answer.
There are certain things you must watch out for, and you have to define what you want to do in that particular case. Let's say:
#array1 = qw(1 1 2 2 3 3 4 4 5 5);
#array2 = qw(1 2 3 4 5);
Are these arrays the same? Or, are they different? They have the same values, but there are duplicates in #array1 and not #array2.
What about this?
#array1 = qw( 1 1 2 3 4 5 );
#array2 = qw( 1 1 2 3 4 5 );
I would say that these arrays are the same, but Array::Utils::arrays_diff begs to differ. This is because Array::Utils assumes that there are no duplicate entries.
And, even the Perl FAQ pointed out by mob also says that It assumes that each element is unique in a given array. Is this an assumption you can make?
No matter what, hashes are the answer. It's easy and quick to look up a hash. The problem is what do you want to do with unique values.
Here's a solid solution that assumes duplicates don't matter:
sub array_diff {
my #array1 = #{ shift() };
my #array2 = #{ shift() };
my %array1_hash;
my %array2_hash;
# Create a hash entry for each element in #array1
for my $element ( #array1 ) {
$array1_hash{$element} = #array1;
}
# Same for #array2: This time, use map instead of a loop
map { $array_2{$_} = 1 } #array2;
for my $entry ( #array2 ) {
if ( not $array1_hash{$entry} ) {
return 1; #Entry in #array2 but not #array1: Differ
}
}
if ( keys %array_hash1 != keys %array_hash2 ) {
return 1; #Arrays differ
}
else {
return 0; #Arrays contain the same elements
}
}
If duplicates do matter, you'll need a way to count them. Here's using map not just to create a hash keyed by each element in the array, but also count the duplicates in the array:
my %array1_hash;
my %array2_hash;
map { $array1_hash{$_} += 1 } #array1;
map { $array2_hash{$_} += 2 } #array2;
Now, you can go through each hash and verify that not only do the keys exist, but that their entries match
for my $key ( keys %array1_hash ) {
if ( not exists $array2_hash{$key}
or $array1_hash{$key} != $array2_hash{$key} ) {
return 1; #Arrays differ
}
}
You will only exit the for loop if all of the entries in %array1_hash match their corresponding entries in %array2_hash. Now, you have to show that all of the entries in %array2_hash also match their entries in %array1_hash, and that %array2_hash doesn't have more entries. Fortunately, we can do what we did before:
if ( keys %array2_hash != keys %array1_hash ) {
return 1; #Arrays have a different number of keys: Don't match
}
else {
return; #Arrays have the same keys: They do match
}
You can use this for getting diffrence between two arrays
#!/usr/bin/perl -w
use strict;
my #list1 = (1, 2, 3, 4, 5);
my #list2 = (2, 3, 4);
my %diff;
#diff{ #list1 } = undef;
delete #diff{ #list2 };
You want to compare each element of #x against the element of the same index in #y, right? This will do it.
print "Index: $_ => \#x: $x[$_], \#y: $y[$_]\n"
for grep { $x[$_] != $y[$_] } 0 .. $#x;
...or...
foreach( 0 .. $#x ) {
print "Index: $_ => \#x: $x[$_], \#y: $y[$_]\n" if $x[$_] != $y[$_];
}
Which you choose kind of depends on whether you're more interested in keeping a list of indices to the dissimilar elements, or simply interested in processing the mismatches one by one. The grep version is handy for getting the list of mismatches. (original post)
n + n log n algorithm, if sure that elements are unique in each array (as hash keys)
my %count = ();
foreach my $element (#array1, #array2) {
$count{$element}++;
}
my #difference = grep { $count{$_} == 1 } keys %count;
my #intersect = grep { $count{$_} == 2 } keys %count;
my #union = keys %count;
So if I'm not sure of unity and want to check presence of the elements of array1 inside array2,
my %count = ();
foreach (#array1) {
$count{$_} = 1 ;
};
foreach (#array2) {
$count{$_} = 2 if $count{$_};
};
# N log N
if (grep { $_ == 1 } values %count) {
return 'Some element of array1 does not appears in array2'
} else {
return 'All elements of array1 are in array2'.
}
# N + N log N
my #a = (1,2,3);
my #b=(2,3,1);
print "Equal" if grep { $_ ~~ #b } #a == #b;
Not elegant, but easy to understand:
#!/usr/local/bin/perl
use strict;
my $file1 = shift or die("need file1");
my $file2 = shift or die("need file2");;
my #file1lines = split/\n/,`cat $file1`;
my #file2lines = split/\n/,`cat $file2`;
my %lines;
foreach my $file1line(#file1lines){
$lines{$file1line}+=1;
}
foreach my $file2line(#file2lines){
$lines{$file2line}+=2;
}
while(my($key,$value)=each%lines){
if($value == 1){
print "$key is in only $file1\n";
}elsif($value == 2){
print "$key is in only $file2\n";
}elsif($value == 3){
print "$key is in both $file1 and $file2\n";
}
}
exit;
__END__
Try to use List::Compare. IT has solutions for all the operations that can be performed on arrays.

How can I compare arrays in Perl?

I have two arrays, #a and #b. I want to do a compare among the elements of the two arrays.
my #a = qw"abc def efg ghy klm ghn";
my #b = qw"def ghy jgk lom com klm";
If any element matches then set a flag. Is there any simple way to do this?
First of all, your 2 arrays need to be written correctly.
#a = ("abc","def","efg","ghy","klm","ghn");
#b = ("def","efg","ghy","klm","ghn","klm");
Second of all, for arbitrary arrays (e.g. arrays whose elements may be references to other data structures) you can use Data::Compare.
For arrays whose elements are scalar, you can do comparison using List::MoreUtils pairwise BLOCK ARRAY1 ARRAY2, where BLOCK is your comparison subroutine. You can emulate pairwise (if you don't have List::MoreUtils access) via:
if (#a != #b) {
$equals = 0;
} else {
$equals = 1;
foreach (my $i = 0; $i < #a; $i++) {
# Ideally, check for undef/value comparison here as well
if ($a[$i] != $b[$i]) { # use "ne" if elements are strings, not numbers
# Or you can use generic sub comparing 2 values
$equals = 0;
last;
}
}
}
P.S. I am not sure but List::Compare may always sort the lists. I'm not sure if it can do pairwise comparisons.
List::Compare
if ( scalar List::Compare->new(\#a, \#b)->get_intersection ) {
…
}
Check to create an intersect function, which will return a list of items that are present in both lists. Then your return value is dependent on the number of items in the intersected list.
You can easily find on the web the best implementation of intersect for Perl. I remember looking for it a few years ago.
Here's what I found :
my #array1 = (1, 2, 3);
my #array2 = (2, 3, 4);
my %original = ();
my #isect = ();
map { $original{$_} = 1 } #array1;
#isect = grep { $original{$_} } #array2;
This is one way:
use warnings;
use strict;
my #a = split /,/, "abc,def,efg,ghy,klm,ghn";
my #b = split /,/, "def,ghy,jgk,lom,com,klm";
my $flag = 0;
my %a;
#a{#a} = (1) x #a;
for (#b) {
if ($a{$_}) {
$flag = 1;
last;
}
}
print "$flag\n";
From the requirement that 'if any element matches', use the intersection of sets:
sub set{
my %set = map { $_, undef }, #_;
return sort keys %set;
}
sub compare{
my ($listA,$listB) = #_;
return ( (set(#$listA)-set(#$listB)) > 0)
}
my #a = qw' abc def efg ghy klm ghn ';
my #b = qw' def ghy jgk lom com klm ';
my $flag;
foreach my $item(#a) {
$flag = #b~~$item ? 0 : 1;
last if !$flag;
}
Note that you will need Perl 5.10, or later, to use the smart match operator (~~) .
Brute force should do the trick for small a n:
my $flag = 0;
foreach my $i (#a) {
foreach my $k (#b) {
if ($i eq $k) {
$flag = 1;
last;
}
}
}
For a large n, use a hash table:
my $flag = 0;
my %aa = ();
$aa{$_} = 1 foreach (#a);
foreach my $i (#b) {
if ($aa{$i}) {
$flag = 1;
last;
}
}
Where a large n is |#a| + |#b| > ~1000 items
IMHO, you should use List::MoreUtils::pairwise. However, if for some reason you cannot, then the following sub would return a 1 for every index where the value in the first array compares equal to the value in the second array. You can generalize this method as much as you want and pass your own comparator if you want to, but at that point, just installing List::MoreUtils would be a more productive use of your time.
use strict; use warnings;
my #a = qw(abc def ghi jkl);
my #b = qw(abc dgh dlkfj jkl kjj lkm);
my $map = which_ones_equal(\#a, \#b);
print join(', ', #$map), "\n";
sub which_ones_equal {
my ($x, $y, $compare) = #_;
my $last = $#$x > $#$y ? $#$x : $#$y;
no warnings 'uninitialized';
return [ map { 0 + ($x->[$_] eq $y->[$_]) } $[ .. $last ];
}
This is Perl. The 'obvious' solution:
my #a = qw"abc def efg ghy klm ghn";
my #b = qw"def ghy jgk lom com klm";
print "arrays equal\n"
if #a == #b and join("\0", #a) eq join("\0", #b);
given "\0" not being in #a.
But thanks for confirming that there is no other generic solution than rolling your own.
my #a1 = qw|a b c d|;
my #a2 = qw|b c d e|;
for my $i (0..$#a1) {
say "element $i of array 1 was not found in array 2"
unless grep {$_ eq $a1[$i]} #a2
}
If you would consider the arrays with different order to be different, you may use Array::Diff
if (Array::Diff->diff(\#a, \#b)->count) {
# not_same
} else {
# same
}
This question still could mean two things where it states "If any element matches then set a flag":
Elements at the same position, i.e $a[2] eq $b[2]
Values at any position, i.e. $a[3] eq $b[5]
For case 1, you might do this:
# iterate over all positions, and compare values at that position
my #matches = grep { $a[$_] eq $b[$_] } 0 .. $#a;
# set flag if there's any match at the same position
my $flag = 1 if #matches;
For case 2, you might do that:
# make a hash of #a and check if any #b are in there
my %a = map { $_ => 1 } #a;
my #matches = grep { $a{$_} } #b;
# set flag if there's matches at any position
my $flag = 1 if #matches;
Note that in the first case, #matches holds the indexes of where there are matching elements, and in the second case #matches holds the matching values in the order in which they appear in #b.