Shift values that satisfy some rule - arrays

I have an array of numbers and wish to remove all the nonpositive (that is, zero or negative) numbers at the start of the array. Here's what I have:
shiftlbl:
$shift = shift #ary;
if (0 >= $shift) {goto shiftlbl;}
else {unshift #ary, $shift;}
Is there a way that works better (faster), or that works approximately equally well but is more Perlish or easier to read?

Without using any module, you can use
shift #ary while #ary && $ary[0] <= 0;
Not only is it much more readable; it's also much faster.
Or, you can try change the array just once, which could speed up the process if the portion to delete is very long:
use List::Util qw{ first };
my $i = first { $ary[$_] > 0 } 0 .. $#ary;
splice #ary, 0, $i;
For -1000 .. 200, I'm getting
Rate old new splice
old 2782/s -- -62% -69%
new 7371/s 165% -- -17%
splice 8886/s 219% 21% --
Here is the whole code:
#!/usr/bin/perl
use warnings;
use strict;
use List::Util qw{ first };
use Test::More;
use Benchmark qw{ cmpthese };
sub old {
my #ary = #_;
shiftlbl:
my $shift = shift #ary;
if (0 >= $shift) {goto shiftlbl;}
else {unshift #ary, $shift;}
return #ary
}
sub new {
my #ary = #_;
shift #ary while #ary && $ary[0] <= 0;
return #ary
}
sub sp {
my #ary = #_;
my $i = first { $ary[$_] > 0 } 0 .. $#ary;
splice #ary, 0, $i;
return #ary
}
my #ar = (-1000 .. 200);
is_deeply([old(#ar)], [new(#ar)], 'old - new');
is_deeply([old(#ar)], [sp(#ar)], 'old - splice');
cmpthese(-5,
{
old => sub { old(#ar) },
new => sub { new(#ar) },
splice => sub { sp(#ar) },
# Also tried with similar results:
# old => 'old( -1000 .. 200)',
# new => 'new( -1000 .. 200)',
# splice => 'sp( -1000 .. 200)',
});
done_testing();

You can use after_incl from List::MoreUtils:
use strict;
use warnings;
use Data::Dump;
use List::MoreUtils qw(after_incl);
my #numbers = (-2, -17, 2, -1, 5, 0);
my #starts_positive = after_incl { $_ > 0 } #numbers;
dd \#starts_positive;
Output:
[2, -1, 5, 0]
after_incl takes a list, applies a block to it until the block returns true, and returns a list of values from that point to the end of the original list.

Related

Remove even amounts of duplicates from an array

I have an array
[ 1, 0, 0, 0, 5, 2, 4, 5, 2, 2 ]
I need to delete even amounts of duplicates.
That means, if a value appears an even number of times in the array then remove them all, but if it appears an odd number of times then keep just one.
The result from the array above should be
[ 1, 0, 2, 4 ]
How can I do that?
Removing duplicates is usually done as follows:
use List::Util 1.44 qw( uniqnum );
#a = uniqnum #a;
or
my %seen;
#a = grep { !$seen{$_}++ } #a;
To achieve what you want, we simply need chain grep that removes the other undesired elements.
use List::Util 1.44 qw( uniqnum );
#a = uniqnum grep { $counts{$_} % 2 } #a;
or
my %seen;
#a = grep { !$seen{$_}++ } grep { $counts{$_} % 2 } #a;
or
my %seen;
#a = grep { ( $counts{$_} % 2 ) && !$seen{$_}++ } #a;
The above solutions rely on having the count of each value. To obtain that, we can use the following:
my %counts;
++$counts{$_} for #a;
All together:
my ( %counts, %seen );
++$counts{$_} for #a;
#a = grep { ( $counts{$_} % 2 ) && !$seen{$_}++ } #a;
Note that these methods of removing duplicates preserve the order of the elements (keeping the first duplicate). This is more efficient (O(N)) then involving sort (O(N log N)) to avoid producing something non-deterministic.
This really isn't difficult, and it is very bad form to show no attempt at all at solving it yourself. I would like someone who posted questions like this to describe how they feel comfortable getting someone else to do their work for them. Even difficult crosswords don't get this flood of requests for a solution, but in this case presumably you are being paid for a solution written by someone else? Why is that not a problem to you?
Build a hash to calculate the current count for each value
use $_ % 2 do determine the new final count
Deconstruct the hash to a new array
my $array = [ 1, 0, 0, 0, 5, 2, 4, 5, 2, 2 ];
my #new_array = do {
my %counts;
++$counts{$_} for #$array;
map {
( $_ ) x ( $counts{$_} % 2 )
} sort { $a <=> $b } keys %counts;
};
use Data::Dump;
dd \#new_array;
output
[0, 1, 2, 4]
See the comments, to see how this possible solution does it.
#!/usr/bin/perl
use strict;
use warnings;
my #a = qw(1 0 0 0 5 2 4 5 2 2);
# Move through the array.
for (my $i = 0; $i < scalar(#a); ) {
# Move through the positions at and ahead of current position $i
# and collect all positions $j, that share the value at the
# current position $i.
my #indexes;
for (my $j = $i; $j < scalar(#a); $j++) {
if ($a[$j] == $a[$i]) {
push(#indexes, $j);
}
}
if (scalar(#indexes) % 2) {
# If the number of positions collected is odd remove the first
# position from the collection. The number of positions in the
# collection is then even afterwards.
shift(#indexes);
# As we will keep the value at the current position $i no new
# value will move into that position. Hence we have to advance
# the current position.
$i++;
}
# Move through the collected positions.
for (my $k = 0; $k < scalar(#indexes); $k++) {
# Remove the element at the position as indicated by the
# $k'th element of the collect positions.
# We have to subtract $k from the collected position, to
# compensate for the movement of the remaining elements to the
# left.
splice(#a, $indexes[$k] - $k, 1);
}
}
print("#a");
You have a bunch of answers, here's another:
use strict;
use warnings;
use Data::Dumper;
my $input = [ 1, 0, 0, 0, 5, 2, 4, 5, 2, 2 ];
my $output = dedupe_evens($input);
print Data::Dumper->Dump([$input, $output], ['$input', '$output']);
exit;
sub dedupe_evens {
my($input) = #_;
my %seen;
$seen{$_}++ foreach #$input;
my #output = grep {
my $count = delete $seen{$_}; # only want first occurrence
$count && $count % 2;
} #$input;
return \#output;
}
Which produces this output (reformatted for brevity):
$input = [ 1, 0, 0, 0, 5, 2, 4, 5, 2, 2 ];
$output = [ 1, 0, 2, 4 ];

Run Function On N Elements of Array at a Time

Let's say I have an array my #arr which is of hypothetical length 240 (but this length is variable). How could I go about running a function on each N elements of that array at a time?
For example, if N = 100, the function would first run on #arr[0..99], then #arr[100..199], and finally #arr[200..239].
My idea was to have some sort of loop which creates a temporary array of length N by joining N elements together, but these seems overly complicated.
while (#arr) {
f(splice(#arr, 0, 100));
}
Non-destructive version:
use List::Util qw( min );
for (my $i=0; $i<#a; $i+=100) {
f(#arr[$i .. min($i+99, $#arr)]);
}
You could also avoid destroying the original array cheaply by creating an array of aliases:
my $shadow = sub { \#_ }->(#arr);
while (#$shadow) {
f(splice(#$shadow, 0, 100));
}
You can use splice:
sub apply_f_to_n_elements {
my ($f, $n, #elements) = #_;
my #results;
while ( #elements ) {
my #batch = splice(#elements, 0, $n)
push #results,
$f->(#batch);
}
return #results;
}
Usage:
apply_f_to_n_elements(\&f, 100, #arr);
or
my #results = apply_f_to_n_elements(\&f, 100, #arr);
The following is optimized to avoid making two copies of every input (while still remaining non-destructive), and optimized to avoid collecting the results of the callback if they're going to be discarded anyway:
sub apply_f_to_n_elements {
my $f = shift;
my $n = shift;
if (wantarray) {
my #results;
while (#_) {
push #results, $f->(splice(#_, 0, $n));
}
return #results;
} else {
while (#_) {
$f->(splice(#_, 0, $n));
}
}
}
Using List::Util qw(min) works well.
However, if you want a more semantic solution, you can use List::MoreUtils qw(natatime).
use List::MoreUtils qw(natatime);
my $iter = natatime 100, #arr;
while (my #vals = $iter->()) {
f(#vals);
}

In Perl, how can I find the last defined element in an array?

Using Perl, I wish to find the last element that is defined in an array.
So far I have the following:
#generating array
$array[100] = (undef);
$array[$columns[1]-1] = $columns [2];
#finding the last element that is defined
for ($i=100; $i>=0; $i--) {
if (($array[$i] != undef) && (!defined($lastdef)) ){
$lastdef=$i;
}
}
I'm not sure why this is not working. Any suggestions to improve, using Perl?
I'm not sure why this is not working. Any suggestions to improve, using Perl?
The reason you don't know why it is not working is because you are not using
use warnings;
If you had, you would have been told:
Use of uninitialized value in numeric ne (!=) at ...
Because != is the numeric inequality operator, and it will convert its parameters to numbers. If you do not have warnings turned on, this will silently convert undef to 0. Needless to say, having warnings turned on is a very good thing, so that you do not make mistakes like this.
It is this line:
if (($array[$i] != undef) ...
That should be
if ((defined($array[$i]) ...
Because it is the defined function that checks a value for definedness. It is an odd mistake to make, since you even use that same function on the same line.
Also, you can make this simpler by doing
if (defined($array[$i])) {
$lastdef = $i;
last;
}
last will here end the loop when the first undefined value is found.
You should also know that you can use a non-hardcoded max value on your loop condition:
for (my $i = $#array; $i >= 0; $i--) {
$#array contains the number of the highest existing index in your array.
You could be more concise by using a List::Util function. This will find the last element in the array that is defined, but not the index of it. To find the index of it, you can do something similar to this answer using defined instead of eq.
use List::Util qw(first);
my $lastdef = first { defined($_) } reverse #array;
The following is a little ugly and obscure (compared to #TLP's excellent answer), but it was fun to write:
#!/usr/bin/env perl
use strict;
use warnings;
use feature 'say';
for my $i (0, 1) {
my $array = generate_array(8, $i);
say join ' ', map $_ // '_', #$array;
say index_of_last_defined_element($array);
}
sub index_of_last_defined_element {
my $x = $#{ $_[0] };
my $v = $_[0]->[$x];
return $x if defined($v) or $x < $[;
$#{ $_[0] } -= 1;
goto &index_of_last_defined_element;
}
sub generate_array {
my $size = shift;
my $array = [ (undef) x $size ];
shift or return $array;
$array->[rand $#$array] = 'x';
return $array;
}
Output:
_ _ _ _ _ _ _ _
-1
_ _ _ _ _ x _ _
5
Of course, this is all a bit silly. You should use List::MoreUtils::last_index:
use feature 'say';
use List::MoreUtils qw(last_index);
for my $i (0, 1) {
my $array = generate_array(8, $i);
say join ' ', map $_ // '_', #$array;
say last_index { defined($_) } #$array;
}
You need to start from 99 as 100 elements array has indexes: 0 .. 99. And break the loop as soon as you find the element:
#!/usr/bin/perl
use strict;
use warnings;
my #array = (1, 2, undef);
my $lastdef;
for (my $i = $#array; $i>=0; $i--) {
if (defined($array[$i])){
$lastdef=$i;
last;
}
}
print $lastdef;
prints: 1

Finding common elements in 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.

In Perl, is there a built in way to compare two arrays for equality?

I have two arrays of strings that I would like to compare for equality:
my #array1 = ("part1", "part2", "part3", "part4");
my #array2 = ("part1", "PART2", "part3", "part4");
Is there a built-in way to compare arrays like there is for scalars?
I tried:
if (#array1 == #array2) {...}
but it just evaluated each array in scalar context, and so compared the length of each array.
I can roll my own function to do it, but it seems like such a low-level operation that there should be a built-in way to do it. Is there?
Edit: sadly, I don't have access to 5.10+ or optional components.
There is the new smart match operator:
#!/usr/bin/perl
use 5.010;
use strict;
use warnings;
my #x = (1, 2, 3);
my #y = qw(1 2 3);
say "[#x] and [#y] match" if #x ~~ #y;
Regarding Array::Compare:
Internally the comparator compares the two arrays by using join to turn both arrays into strings and comparing the strings using eq.
I guess that is a valid method, but so long as we are using string comparisons, I would much rather use something like:
#!/usr/bin/perl
use strict;
use warnings;
use List::AllUtils qw( each_arrayref );
my #x = qw(1 2 3);
my #y = (1, 2, 3);
print "[#x] and [#y] match\n" if elementwise_eq( \(#x, #y) );
sub elementwise_eq {
my ($xref, $yref) = #_;
return unless #$xref == #$yref;
my $it = each_arrayref($xref, $yref);
while ( my ($x, $y) = $it->() ) {
return unless $x eq $y;
}
return 1;
}
If the arrays you are comparing are large, joining them is going to do a lot of work and consume a lot of memory than just comparing each element one by one.
Update: Of course, one should test such statements. Simple benchmarks:
#!/usr/bin/perl
use strict;
use warnings;
use Array::Compare;
use Benchmark qw( cmpthese );
use List::AllUtils qw( each_arrayref );
my #x = 1 .. 1_000;
my #y = map { "$_" } 1 .. 1_000;
my $comp = Array::Compare->new;
cmpthese -5, {
iterator => sub { my $r = elementwise_eq(\(#x, #y)) },
array_comp => sub { my $r = $comp->compare(\(#x, #y)) },
};
This is the worst case scenario where elementwise_eq has to go through each and every element in both arrays 1_000 times and it shows:
Rate iterator array_comp
iterator 246/s -- -75%
array_comp 1002/s 308% --
On the other hand, the best case scenario is:
my #x = map { rand } 1 .. 1_000;
my #y = map { rand } 1 .. 1_000;
Rate array_comp iterator
array_comp 919/s -- -98%
iterator 52600/s 5622% --
iterator performance drops quite quickly, however:
my #x = 1 .. 20, map { rand } 1 .. 1_000;
my #y = 1 .. 20, map { rand } 1 .. 1_000;
Rate iterator array_comp
iterator 10014/s -- -23%
array_comp 13071/s 31% --
I did not look at memory utilization.
There's Test::More's is_deeply() function, which will also display exactly where the structures differ, or Test::Deep's eq_deeply(), which doesn't require a test harness (and just returns true or false).
Not built-in, but there is Array::Compare.
This is one of the operations that's left out of the Perl core for what I believe are didactic reasons -- that is, if you're trying to do it, there's probably something wrong. The most illustrative example of this, I think, is the absence of a core read_entire_file function; basically, providing that function in the core would lead people to think it's a good idea to do that, but instead, Perl is designed in a way that gently nudges you toward processing files line-at-a-time, which is generally far more efficient and otherwise a better idea, but novice programmers are rarely comfortable with it and they need some encouragement to get there.
The same applies here: there is probably a much better way to make the determination you're trying to accomplish by comparing two arrays. Not necessarily, but probably. So Perl is nudging you to think about other ways of accomplishing your goal.
Perl 5.10 gives you the smart match operator.
use 5.010;
if( #array1 ~~ #array2 )
{
say "The arrays are the same";
}
Otherwise, as you said, you'll have top roll your own.
So long as you are using perl 5.10 or newer, you can use the smart match operator.
if (#array1 ~~ #array2) {...}
Simpler solution is faster:
#!/usr/bin/perl
use strict;
use warnings;
use Array::Compare;
use Benchmark qw( cmpthese );
use List::AllUtils qw( each_arrayref );
my #x = 1 .. 1_000;
my #y = map { "$_" } 1 .. 1_000;
my $comp = Array::Compare->new;
cmpthese -2, {
iterator => sub { my $r = elementwise_eq(\(#x, #y)) },
my_comp => sub { my $r = my_comp(\(#x, #y)) },
array_comp => sub { my $r = $comp->compare(\(#x, #y)) },
};
#x = 1 .. 20, map { rand } 1 .. 1_000;
#y = 1 .. 20, map { rand } 1 .. 1_000;
cmpthese -2, {
iterator => sub { my $r = elementwise_eq(\(#x, #y)) },
my_comp => sub { my $r = my_comp(\(#x, #y)) },
array_comp => sub { my $r = $comp->compare(\(#x, #y)) },
};
sub elementwise_eq {
my ($xref, $yref) = #_;
return unless #$xref == #$yref;
my $it = each_arrayref($xref, $yref);
while ( my ($x, $y) = $it->() ) {
return unless $x eq $y;
}
return 1;
}
sub my_comp {
my ($xref, $yref) = #_;
return unless #$xref == #$yref;
my $i;
for my $e (#$xref) {
return unless $e eq $yref->[$i++];
}
return 1;
}
And result in perl 5, version 14, subversion 2 (v5.14.2) built for x86_64-linux-gnu-thread-multi:
Rate iterator array_comp my_comp
iterator 1544/s -- -67% -80%
array_comp 4697/s 204% -- -41%
my_comp 7914/s 413% 68% --
Rate iterator array_comp my_comp
iterator 63846/s -- -1% -75%
array_comp 64246/s 1% -- -75%
my_comp 252629/s 296% 293% --
This question has turned into a very useful resource. ++ for the benchmarks and discussion.
As others have pointed out smart match feature had issues and is being phased out in its current form. There are alternatives that are "less smart" (and so avoid the issues) and that are small, fairly fast and don't have too many non CORE dependencies.
Smart::Match
match::simple (and match::smart)
Scalar::In
You can find links to some pretty good discussions about the history of the future of ~~ by looking at a couple of blog posts by #brian d foy, and the p5p mail archive threads from 2011 and 2012 from #rjbs.
Comparing arrays can be simple and fun!
use v5.20;
use match::smart;
my #x = (1, 2, 3);
my #y = qw(4 5 6);
my #z = qw(4 5 6);
say \#x |M| \#y ? "[\#x] and [\#y] match": "no match";
say \#y |M| \#z ? "[\#y] and [\#z] match": "no match";
__END__
#y and #z match, #x and #y do not
... especially fun if the array is simple. But an array can be a complicated thing, and sometimes you want different kinds of information from the results of the comparison. For that, Array::Compare can make fine tuned comparison easier.
Data::Cmp is another recent option. The cmp_data() function operates similarly to the cmp operator (see perlop for cmp usage).
Example:
use 5.10;
use Data::Cmp qw/cmp_data/;
my #array1 = ("part1", "part2", "part3", "part4");
my #array2 = ("part1", "PART2", "part3", "part4");
my #array3 = ("part1", "PART2", "part3", "part4");
# sample usage
say "1 & 2 are different" if cmp_data(\#array1, \#array2) ;
sat "2 & 3 are the same" unless cmp_data(\#array2, \#array3) ;
It's also possible to compare hashes and more complicated nested data structures (within reason). For a single module with no non-core dependencies, Data::Cmp is pretty "smart" ;-) ... errm I mean "useful".
One could use grep function in scalar context (http://perldoc.perl.org/functions/grep.html#grep-BLOCK-LIST)
($#array1 == $#array2) && (0 == (grep { $array1[ $_ ] ne $array2[ $_ ] } 0..$#array1))
My core-only solution with List::Util::all:
use List::Util qw(all);
if (#array1 == #array2 && all { $array1[$_] eq $array2[$_] } 0..$#array1) {
print "matched\n";
}
As a subroutine:
# call me like string_array_equals([#array1], [#array2])
sub string_array_equals {
my ($array1, $array2) = #_;
#$array1 == #$array2 and
all { $array1->[$_] eq $array2->[$_] } 0..$#$array1;
}
If you want a custom comparison:
# call me like array_equals { $a eq $b } [#array1], [#array2]
sub array_equals(&$$) {
my ($compare, $array1, $array2) = #_;
#$array1 == #$array2 and
all {
local $a = $array1->[$_];
local $b = $array2->[$_];
$compare->($a, $b);
} 0..$#$array1;
}
At this point, all doesn't save much space and you could just do a for:
# call me like array_equals { $a eq $b } [#array1], [#array2]
sub array_equals(&$$) {
my ($compare, $array1, $array2) = #_;
#$array1 == #$array2 or return 0;
for (0..$#$array1) {
local $a = $array1->[$_];
local $b = $array2->[$_];
$compare->($a, $b) or return 0;
}
1;
}
Edit: List::Util::first works as a substitute on older perls (< v5.20).
use List::Util qw(first);
if (#array1 == #array2 && !defined first { $array1[$_] ne $array2[$_] } 0..$#array1) {
print "matched\n";
}
If casing is the only difference, you can simply use:
if (lc "#array1" eq lc "#array2") {...}
Whereas "#array1" returns the same as join ( " ", #array1 )
If order and duplicate values do not matter but only values equality (i.e. set comparison), you could use Set::Scalar.
It overloads common operators such as == or !=.
my #array1 = ("part1", "part2", "part3", "part4");
my #array2 = ("part1", "PART2", "part3", "part4");
if ( Set::Scalar->new(#array1) == Set::Scalar->new(#array2) ) {...}
Alternatively, there's also Algorithm::Diff and List::Compare.
For checking equality of two arrays try this.
In given code, if %eq_or_not has any value then both arrays are not equal otherwise they are equal.
my #array1 = ("part1", "part2", "part3", "part4");
my #array2 = ("part1", "PART2", "part3", "part4");
my %eq_or_not;
#eq_or_not{ #array1 } = undef;
delete #eq_or_not{ #array2 };
if (join(",",sort #a) eq join(",",sort #b))
if performance concern can be ignored, as mentioned several times in the threads here
If the only criteria is "are they equivalent or not?", and not the more complex question, "are they equivalent or not, and if they differ, how?" there are much quicker/uglier ways to do it. For example, smash the entirety of each array into two scalars and compare those.
For example
my #array1 = ("part1", "part2", "part3", "part4");
my #array2 = ("part1", "PART2", "part3", "part4");
my $smash1 = join("", #array1);
my $smash2 = join("", #array2);
if ($smash1 eq $smash2)
{
# equal
}
else
{
#unequal
}
Yes, I probably just made Larry Wall cry.

Resources