Finding common elements in arrays - arrays

I have a hash whose values are arrays. I need to find the common elements of those arrays,
ie. the elements that are present in all the arrays. So I extracted the values of the hash into
a multidimensional array whose each row corresponds to an array in the hash. Then I took the first row
of this matrix into another array (#arr1) and iterated through it to find if there was any element
in arr1 that was also in the rest of the rows of the matrix. If such an element is found, it is
pushed onto another array that contains the final list of all the elements. The code is as follows
(I hope it is clear enough):
sub construct_arr(my %records) {
my $len = keys %records;
my #matrix;
my $i = 0;
# Extract the values of the hash into a matrix
foreach my $key (keys %records) {
$matrix[$i] = $records{$key};
$i++;
}
my #arr1 = $matrix[0];
my #final;
# Iterate through each element of arr1
for my $j (0..$#{$arr1[0]}) {
my $count = 1;
# Iterate through each row of the matrix, starting from the second
for ( my $i = 1; $i < $len ; $i++ ) {
my $flag = 0;
# Iterate through each element of the row
for my $k (0..$#{$matrix[$i]}) {
if ($arr1[0][$j] eq $matrix[$i][$k]) {
$flag = 1;
$count++;
}
}
# On finding the first instance of the element in a row, go to the next row
if (!$flag == 1) {
last;
}
}
# If element is in all the rows, push it on to the final array
if ($count == $len) {
push(#final, $arr1[0][$j]);
}
}
return #final;
}
I know that the above works, but I would like to know if there is any other (perlish) way to do this.
I am starting to learn perl and I am very interested in knowing things that could make my work easier
in perl as compared to other languages. If my code is the best that can be done, please let me know that
too. Any guidance would be appreciated. Thanks!

Take a look at Chris Charley's link for calculating the intersection of arrays.
Hashes are the clear way to go for problems like this. Together with map and grep a solution can be reduced to just a few lines.
This program uses sundar's data for want of anything better, and seems to do what you need.
use strict;
use warnings;
my %records = (
a => [ qw/ A B C / ],
b => [ qw/ C D E A / ],
c => [ qw/ A C E / ],
);
print "$_\n" for construct_arr(\%records);
sub construct_arr {
my $records = shift;
my %seen;
$seen{$_}++ for map #$_, values %$records;
grep $seen{$_} == keys %$records, keys %seen;
}
output
A
C
Edit
I thought it may help to see a more Perlish, tidied version of your own solution.
use strict;
use warnings;
my %records = (
a => [ qw/ A B C / ],
b => [ qw/ C D E A / ],
c => [ qw/ A C E / ],
);
print "$_\n" for construct_arr(\%records);
sub construct_arr {
my $records = shift;
my #matrix = values %$records;
my #final;
# iterate through each element the first row
for my $i ( 0 .. $#{$matrix[0]} ) {
my $count = 1;
# look for this value in all the rest of the rows, dropping
# out to the next row as soon as a match is found
ROW:
for my $j ( 1 .. $#matrix ) {
for my $k (0 .. $#{$matrix[$j]}) {
next unless $matrix[0][$i] eq $matrix[$j][$k];
$count++;
next ROW;
}
}
# If element is in all the rows, push it on to the final array
push #final, $matrix[0][$i] if $count == #matrix;
}
return #final;
}
The output is the same as for my own program, but the functionality is slightly different as mine assumes the values in each row are unique. If the sama value appears more than once my solution will break (the same applies to sundar's). Please let me know if that is acceptable.

Although the poster explained there aren't duplicates within a single array, here is my attempt which handles that case too (notice the slightly modified test data - "5" should not be printed):
#!/usr/bin/env perl
use warnings;
use strict;
my %records = (
a => [1, 2, 3],
b => [3, 4, 5, 1],
c => [1, 3, 5, 5]
);
my %seen;
while (my ($key, $vals) = each %records) {
$seen{$_}{$key} = 1 for #$vals;
}
print "$_\n" for grep { keys %{$seen{$_}} == keys %records } keys %seen;

You can find the size of the hash easily using scalar(keys %hash);
Here's an example code that does what you need:
#!/usr/bin/perl
use strict;
use warnings;
my %records = ( a => [1, 2, 3],
b => [3, 4, 5, 1],
c => [1, 3, 5]
);
my %count;
foreach my $arr_ref (values %records) {
foreach my $elem (#$arr_ref) {
$count{$elem}++;
}
}
my #intersection;
my $num_arrays = scalar(keys %records);
foreach my $elem (keys %count) {
#If all the arrays contained this element,
#allowing for multiple entries per array
if ($count{$elem} >= $num_arrays) {
push #intersection, $elem;
}
}
Feel free to comment if you need any clarification in this code. And the second foreach that constructs the #intersection array is written this way only for clarity - if you're learning Perl, I'd suggest you study and rewrite it using the map construct, since that's arguably more idiomatic Perl.

Related

Perl sort hash of hashes by the third-level key and compare it

My data structure is
my %hash = (
firstkey => {
secondkey => {
2 => ['9','2'],
1 => ['3','4'],
3 => ['8','2']
}
}
);
print Dumper \%hash;
I want to sort the hash by the thirdly key. i.e. 1, 2 and 3 in this case
and then compare the second element (index[1]) in the array. If they are the same, and then print it out.
Expected Sorted Hash:
my %hash = (
firstkey => {
secondkey => {
1 => ['3','4'],
2 => ['9','2'],
3 => ['8','2']
}
}
);
print Dumper \%hash;
After sort the hash, we compare the index[1] of the 1st array[3,4] with the 2nd array[9,2].
4 is not equal to 2, so we are not going to print anything.
Then, we compare the index[1] of the 2nd array[9,2] with the 3rd array[4,2].
2 is equal to 2, then we are going to print all the content of it
firstkey, secondkey, 3, [8,2]
we only need to compare the adjacent array.
I read a lot of solutions about sorting the hash, but I couldn't find one solution that really reorders it Is it any way to reorder the hash by the key and construct a hash with the new order in Perl?
Or we can only sort the hash by using the for loop and compare it in the for loop?
One cannot have a "sorted hash" – they are intrinsically unordered data structures (see keys). The randomizaton of the initial seed and hash traversal are even enhanced for security purposes.
But we can sort the list of hash keys as needed. Then we have an ordered list to iterate over and thus can process the hash in a "sorted manner."
The keys to sort by here are at a deeper level, so iterate over the upper (two) levels to get to them. Then it's a straightforward sort and test
use warnings;
use strict;
use feature 'say';
my %hash = (
firstkey1 => {
secondkey1 => {
2 => [9, 2], 1 => [3, 4], 3 => [8, 2]
}
}
);
foreach my $k1 (keys %hash)
{
foreach my $k2 (keys %{$hash{$k1}})
{
# Relieve syntax below
my $hr = $hash{$k1}{$k2};
my #sr_k3 = sort { $a <=> $b } keys %{$hr};
foreach my $i (1..$#sr_k3)
{
if ( $hr->{$sr_k3[$i]}[1] == $hr->{$sr_k3[$i-1]}[1] )
{
say "$k1, $k2, $sr_k3[$i], ",
'[', join(',', #{$hr->{$sr_k3[$i]}}), ']';
}
}
#say "#{$hash{$k1}{$k2}{$_}}" for keys %{$hash{$k1}{$k2}};
}
}
A few notes
Sorted keys are iterated over starting with the second one due to the comparison criterion
Hashref is copied at the second level only for convenience, to relieve the messy syntax
When complex data structures get too unwieldy it may be time to use a class instead
This works for any number of keys in both levels (only one key is shown for each level).
As has been said, you won't be able to dictate the order of the hash. Here's a way to map it to something you can sort and do the comparison you need.
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
my %hash = ( firstkey => {
secondkey => {
2 => [9,2],
1 => [3,4],
3 => [8,2],
}
}
);
#obtain an array of two-element array refs, whose contents are the keys
#for the "secondkey" hash and the corresponding value, respectively
my #arr = map { [ $_, $hash{firstkey}->{secondkey}->{$_} ] }
keys %{$hash{firstkey}->{secondkey}};
#sort on the aforementioned key
my #sorted = sort { $a->[0] <=> $b->[0] } #arr;
#obtain an array of array refs, whose contents are a pair of adjacent
#elements from the #sorted array
my #ordered_pairs = map { [ $sorted[$_], $sorted[$_+1] ] }
(0 .. (scalar #sorted - 2));
#compare the elements in question, and do something if there's a match
for (#ordered_pairs) {
if ($_->[0][1][1] == $_->[1][1][1]) {
print Dumper $_->[1];
}
}

Is it possible to assign two variables in Perl foreach loop?

Is it possible to assign two variables the same data from an array in a Perl foreach loop?
I am using Perl 5, I think I came across something in Perl 6.
Something like this:
my $var1;
my $var2;
foreach $var1,$var2 (#array){...}
It's not in the Perl 5 core language, but List::Util has a pairs function which should be close enough (and a number of other pair... functions which may be more convenient, depending on what you're doing inside the loop):
#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;
use List::Util 'pairs';
my #list = qw(a 1 b 2 c 3);
for my $pair (pairs #list) {
my ($first, $second) = #$pair;
say "$first => $second";
}
Output:
a => 1
b => 2
c => 3
The easiest way to use this is with a while loop that calls splice on the first two elements of the array each time,
while (my($var1, $var2) = splice(#array, 0, 2)) {
...
}
However, unlike foreach, this continually does a double-shift on the original array, so when you’re done, the array is empty. Also, the variables assigned are copies, not aliases as with foreach.
If you don’t like that, you can use a C-style for loop:
for (my $i = 0; $i < #array; $i += 2) {
my($var1, $var2) = #array[$i, $i+1];
...
}
That leaves the array in place but does not allow you to update it the way foreach does. To do that, you need to address the array directly.
my #pairlist = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
for (my $i = 0; $i < #pairlist; $i += 2) {
$pairlist[ $i + 0 ] x= 2;
$pairlist[ $i + 1 ] *= 2;
}
print "Array is #pairlist\n";
That prints out:
Array is feefee 2 fiefie 4 foefoe 6 fumfum 8
You can get those into aliased variables if you try hard enough, but it’s probably not worth it:
my #kvlist = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
for (my $i = 0; $i < #kvlist; $i += 2) {
our ($key, $value);
local(*key, $value) = \#kvlist[ $i, $i + 1 ];
$key x= 2;
$value *= 2;
}
print "Array is #kvlist\n";
Which prints out the expected changed array:
Array is feefee 2 fiefie 4 foefoe 6 fumfum 8
Note that the pairs offered by the List::Pairwise module, which were but very recently added to the core List::Util module (and so you probably cannot use it), are still not giving you aliases:
use List::Util 1.29 qw(pairs);
my #pairlist = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
for my $pref (pairs(#pairlist)) {
$pref->[0] x= 2;
$pref->[1] *= 2;
}
print "Array is #pairlist\n";
That prints out only:
Array is fee 1 fie 2 foe 3 fum 4
So it didn’t change the array at all. Oops. :(
Of course, if this were a real hash, you could double the values trivially:
for my $value (values %hash) { $value *= 2 }
The reasons that works is because those are aliases into the actual hash values.
You cannot change the keys, since they’re immutable. However, you can make a new hash that’s an updated copy of the old one easily enough:
my %old_hash = (
fee => 1,
fie => 2,
foe => 3,
fum => 4,
);
my %new_hash;
#new_hash{ map { $_ x 2 } keys %old_hash } =
map { $_ * 2 } values %old_hash;
print "Old hash is: ", join(" " => %old_hash), "\n";
print "New hash is: ", join(" " => %new_hash), "\n";
That outputs
Old hash is: foe 3 fee 1 fum 4 fie 2
New hash is: foefoe 6 fiefie 4 fumfum 8 feefee 2
A general algorithm for more than 2 variables:
while( #array ){
my $var1 = shift #array;
my $var2 = shift #array;
my $var3 = shift #array;
# other variables from #array
# do things with $var1, $var2, $var3, ...
}
PS: Using a working copy of the array to that it is preserved for use later:
if( my #working_copy = #array ){
while( #working_copy ){
my $var1 = shift #working_copy;
my $var2 = shift #working_copy;
my $var3 = shift #working_copy;
# other variables from #working_copy
# do things with $var1, $var2, $var3, ...
}
}
PPS: another way is to use indexing. Of course, that is a sure sign that the data structure is wrong. It should be an array of arrays (AoA) or an array of hashes (AoH). See perldoc perldsc and perldoc perllol.
my $i = 0;
while( $i < #array ){
my $var1 = $array[ $i++ ];
my $var2 = $array[ $i++ ];
my $var3 = $array[ $i++ ];
# other variables from #array
# do things with $var1, $var2, $var3, ...
}
PPPS: I've been asked to clarify why the data structure is wrong. It is a flatten set of tuples (aka records aka datasets). The tuples are recreated by counting of the number of data for each. But what is the reader constructing the set has a bug and doesn't always get the number right? If, for a missing value, it just skips adding anything? Then all the remaining tuples are shifted by one, causing the following tuples to be grouped incorrectly and therefore, invalid. That is why an AoA is better; only the tuple with the missing data would be invalid.
But an better structure would be an AoH. Each datum would access by a key. Then new or optional data can be added without breaking the code downstream.
While I'm at it, I'll add some code examples:
# example code for AoA
for my $tuple ( #aoa ){
my $var1 = $tuple->[0];
my $var2 = $tuple->[1];
my $var3 = $tuple->[2];
# etc
}
# example code for AoH
for my $tuple ( #aoh ){
my $var1 = $tuple->{keyname1};
my $var2 = $tuple->{key_name_2};
my $var3 = $tuple->{'key name with spaces'};
my $var4 = $tuple->{$key_name_in_scalar_variable};
# etc
}
Here is a module-less way to "loop" by an arbitrary value ($by) and output the resulting group of elements using an array slice:
#!perl -l
#array = "1".."6";
$by = 3; $by--;
for (my $i = 0 ; $i < #array ; $i += $by ) {
print "#array[$i..$i+$by]";
$i++ ;
}
As a one-liner to test (cut and paste to a Unix shell):
perl -E '#array = "1".."6"; $by = 3; $by--;
for (my $i = 0 ; $i < #array ; $i += $by ) {
say "#array[$i..$i+$by]"; $i++ }'
Output:
1 2 3
4 5 6
If you make $by = 2; it will print pairs of numbers. To get at specific elements of the resulting slice access it as an anonymous array: (e.g. [#array[$i..$i+$by]]->[1]).
See also:
How do I read two items at a time in a Perl foreach loop?
Perl way of iterating over 2 arrays in parallel
Some good responses there, including reference to natatime which is quite easy to use. It's easy to implement too - it is essentially a wrapper around the splice solutions mentioned in the responses here.
The following is not the nicest example, but I've been using autobox::Core and made an #array->natatime() "method" ;-) like this:
use autobox::Core ;
sub autobox::Core::ARRAY::natatime {
my ($self, $by) = #_;
my #copy = #$self ;
my #array ;
push #array, [splice (#copy, 0, $by) ] while #copy ;
if ( not defined wantarray ) {
print "#{ $_ } \n" for #array ;
}
return wantarray ? #array : \#array;
}
The #copy array is spliced destructively, but $self (which is how the #array in front of the autobox method -> arrow gets passed to the function) is still there. So I can do:
my #dozen = "1" .. "12" ; # cakes to eat
#dozen->natatime(4) ; # eat 4 at time
my $arr_ref = #dozen->natatime(4) ; # make a reference
say "Group 3: #{ $arr_ref->[2] }" ; # prints a group of elements
say scalar #dozen , " cakes left" ; # eat cake; still have it
Output:
1 2 3 4
5 6 7 8
9 10 11 12
Group 3: 9 10 11 12
12 cakes left
One other approach that also uses a CPAN module (I gave this answer elsewhere but it is worth repeating). This can also be done non-destructively, with Eric Strom's excellent List::Gen module:
perl -MList::Gen=":all" -E '#n = "1".."6"; say "#$_" for every 2 => #n'
1 2
3 4
5 6
Each group of elements you grab is returned in an anonymous array so the individual values are in: $_->[0] $_->[1] ... etc.
You mentioned Perl6, which handles multiple looping values nicely:
my #qarr = 1 .. 6;
my ($x, $y, $z) ;
for #qarr -> $x , $y , $z { say $x/$y ; say "z = " ~ $z }
Output:
0.5
z = 3
0.8
z = 6
For more on the Perl6 approach see: Looping for Fun and Profit from the 2009 Perl6 Advent Calendar, or the Blocks and Statements Synopsis for details. Perhaps Perl 5 will have a similar "loop by multliple values" construct one day - à la perl5i's foreach :-)

What is the 'best' way to delete multiple non-sequential elements in a Perl array?

While executing a script, I need to delete multiple elements (these elements are not sequential) of an array. I will get my array and indexes while executing the script.
For example:
I may get an array and list of indexes like below:
my #array = qw(one two three four five six seven eight nine);
my #indexes = ( 2, 5, 7 );
I have below subroutine to do this:
sub splicen {
my $count = 0;
my $array_ref = shift #_;
croak "Not an ARRAY ref $array_ref in $0 \n"
if ref $array_ref ne 'ARRAY';
for (#_) {
my $index = $_ - $count;
splice #{$array_ref}, $index, 1;
$count++;
}
return $array_ref;
}
If I call my subroutine like below:
splicen(\#array , #indexes);
That works for me but:
Is there any better way to do this?
If instead you splice from the end of the array, you won't have to maintain the offset $count:
sub delete_elements {
my ( $array_ref, #indices ) = #_;
# Remove indexes from end of the array first
for ( sort { $b <=> $a } #indices ) {
splice #$array_ref, $_, 1;
}
}
Another way think about it is to build a new array rather than modifying the original:
my #array = qw(one two three four five size seven eight nine);
my #indexes = (2, 5, 7);
my %indexes = map { $_ => 1 } #indexes;
my #kept = map { $array[$_] } grep { ! exists $indexes{$_} } 0 .. $#array;

Loop over one dimension of a multi-dimensional array in Perl using for each

* UPDATED* for typos
Another PERL question.... I am trying to loop through a 2D array. I am positive about the size of one dimension but unsure on the second. The code snippet:
foreach my $value (#surfaces[1])
{
my $sum = 0;
my $smallest = 9999;
my $limit_surface = 0;
for (my $i = 0; $i < 3; $i++)
{
$sum += $surfaces[$i][$counter];
if ($surfaces[$i][$counter] <= $smallest)
{
$smallest = $surfaces[$i][$counter];
$limit_surface = $subchannel_number[$i];
}
}
$counter++;
push(#avg_value,$sum/#rodsurface_number);
push(#limiting_schan,$limit_surface);
push(#limiting_value,$smallest);
}
I am compiled but $value variable is failing to initialize.
Repeat after me:
Perl does not have multidimensional arrays
Perl does not have multidimensional arrays
Perl does not have multidimensional arrays
What Perl does have is have are arrays that contain references pointing to other arrays. You can emulate multidimensional arrays in Perl, but they are not true multidimensional arrays. For example:
my #array;
$array[0] = [ 1, 2, 3, 4, 5 ];
$array[1] = [ 1, 2, 3 ];
$array[2] = [ 1, 2 ];
I can talk about $array[0][1], and $array[2][1], but while $array[0][3] exists, $array[2][3] doesn't exist.
If you don't understand references, read the tutorial on references.
What you need to do is go through your array and then find out the size of each subarray and go through each of those. There's no guarantee that
The reference contained in your primary array actually points to another array:
That your sub-array contains only scalar data.
You can use the $# operator to find the size of your array. For example $#array is the number of items in your array. You an use ( 0..$#array ) to go through each item of your array, and this way, you have the index to play around with.
use strict;
use warnings;
my #array;
$array[0] = [ 1, 2, 3, 4, 5 ];
$array[1] = [ 1, 2, 3 ];
$array[2] = [ 1, 2, ];
#
# Here's my loop for the primary array.
#
for my $row ( 0..$#array ) {
printf "Row %3d: ", $row ;
#
# My assumption is that this is another array that contains nothing
# but scalar data...
#
my #columns = #{ $array[$row] }; # Dereferencing my array reference
for my $column ( #columns ) {
printf "%3d ", $column;
}
print "\n";
}
Note I did my #columns = #{ $array[$row] }; to convert my reference back into an array. This is an extra step. I could have simply done the dereferencing in my for loop and saved a step.
This prints out:
Row 0: 1 2 3 4 5
Row 1: 1 2 3
Row 2: 1 2
I could put some safety checks in here. For example, I might want to verify the size of each row, and if one row doesn't match the other, complain:
my $row_size = $array[0];
for my $row ( 1..$#array ) {
my #columns = #{ $array[$row] };
if ( $#columns ne $array_size ) {
die qq(This is not a 2D array. Not all rows are equal);
}
}
You do not describe your data structure, nor explain exactly what you want to do with it. This limits the advice that we can give to just the general variety.
If you're trying to iterate over an array of arrays, I would advise you to do it based off of element instead of index.
For example, below I have a 4 by 5 matrix of integers. I would like to find the average of these values. One way to do this is to simply iterate over each row and then column, and add up the values:
use strict;
use warnings;
my #AoA = (
[11, 12, 13, 14, 15],
[21, 22, 23, 24, 25],
[31, 32, 33, 34, 35],
[41, 42, 43, 44, 45],
);
my $sum = 0;
my $count = 0;
for my $row (#AoA) {
for my $element (#$row) { # <-- dereference the array ref
$sum += $element;
$count++;
}
}
print "Average of Matrix is " . ($sum / $count) . "\n";
Outputs:
Average of Matrix is 28
For more information on complex data structures, check out: Perl Data Structures Cookbook
I've set up some dummy variables and changed a few things around. This compiles and produces the results I show below.
This might not answer your question, but should allow you to copy and paste the code, run it yourself, edit the input and see how the output compares to what you want.
use warnings;
use strict;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;
my #surfaces = ( ['1','2','3'],
['10','20','30'],
['100','200','400'],
);
my #subchannel_number = ( ['1','2','3'],
['10','20','30'],
['100','200','400'],
);
my #rodsurface_number = (1 .. 10);
my $counter = 0;
my (#avg_value, #limiting_schan, #limiting_value);
foreach my $value ($surfaces[1]){
my $sum = 0;
my $smallest = 9999;
my $limit_surface = 0;
for (my $i = 0; $i < 3; $i++) {
$sum += $surfaces[$i][$counter];
if ($surfaces[$i][$counter] <= $smallest){
$smallest = $surfaces[$i][$counter];
$limit_surface = $subchannel_number[$i];
}
}
$counter++;
push(#avg_value,$sum/#rodsurface_number);
push(#limiting_schan,$limit_surface);
push(#limiting_value,$smallest);
}
print Dumper (\#avg_value, \#limiting_schan, \#limiting_value);
$VAR1 = [
'11.1'
];
$VAR2 = [
[
'1',
'2',
'3'
]
];
$VAR3 = [
1
];

Perl - Building array of arrays leads to overflow

I am trying to analyze a hashmap, for duplicate values and getting their keys in arrays. These arrays will be in an array of arrays. I am a newbie, by the way. However it never stops running when I start it. Where am I wrong?
while (($k,$v)=each %hashmap){
$hasduplicate = 0;
delete $hashmap{$k};
#dups = ();
while (($k1,$v1) = each %hashmap){
if ($v1 eq $v) {
$hasduplicate = 1;
push #dups, $k1;
delete $hashmap{$k1};
}
}
if ($hasduplicate){
push (#dups, $k);
push #dupsarray, [#dups];}
}
Each hash has just one iterator aligned to itself in Perl (see each). Therefore, running each for the same hash in a loop that calls each is not doing what you think.
If you want to see what's going on, try adding the following line at the start of the outer loop:
warn $k;
You are missing several dollar signs before variable names. For example, you probably want to delete $hashmap{$k} instead of $hashmap{k}, which is equivalent to $hashmap{'k'}.
To output an array of arrays, you have to dereference the inner arrays:
print map "#$_\n", #dupsarray;
BTW, I would use a hash of arrays to solve your task. Here's how:
my %dups;
while (my ($k, $v) = each %hashmap) {
push #{ $dups{$v} }, $k;
}
for my $k (grep #{ $dups{$_} } > 1, keys %dups) {
print "$k: #{ $dups{$k} }\n";
}
The problem is that there can be only one each sequence per hash, as there is only a single index to keep track of the next key/value pair.
In addition, you are using k and k1 in a few places where you mean $k and $k1. You must always use strict and use warnings at the top of every Perl program. This would have alerted you to the problem.
You can get around this problem by using for my $k1 (keys %hashmap) { ... } for the inside loop. This will create a separate list of keys to assign to $k1 in turn so that there is no multiple use of the iterator.
This modification of your code does what I think you want.
use strict;
use warnings;
my %hashmap = (
a => 'a',
b => 'b',
c => 'a',
d => 'c',
);
my #dupsarray;
while (my ($k, $v) = each %hashmap) {
my $hasduplicate = 0;
delete $hashmap{$k};
my #dups;
for my $k1 (keys %hashmap) {
my $v1 = $hashmap{$k1};
if ($v1 eq $v) {
$hasduplicate = 1;
push #dups, $k1;
delete $hashmap{$k1};
}
}
if ($hasduplicate) {
push(#dups, $k);
push #dupsarray, [#dups];
}
}
use Data::Dump;
dd \#dupsarray;
output
[["a", "c"]]
A much simpler method is to create an inverted hash where the keys and values of the original hash are swapped. Then just pick out the values of the inverted hash that have more than one element. This program demonstrates
use strict;
use warnings;
my %hashmap = (
a => 'a',
b => 'b',
c => 'a',
d => 'c',
);
my #dupsarray = do {
my %inverted;
while (my ($k, $v) = each %hashmap) {
push #{ $inverted{$v} }, $k;
}
grep { #$_ > 1 } values %inverted;
};
use Data::Dump;
dd \#dupsarray;
output
[["c", "a"]]

Resources