Modifying an array through a reference - perl

Question

I am trying to write a subroutine that will receive an array reference and then delete some of the elements of the array. For example:
use strict;
use warnings;
my #a = (1, 2, 3, 6);
func1 (\#a);
sub func1 {
my $a = shift;
my #b = (2, 6);
for my $val_to_remove (#b) {
for my $i (0..$#$a) {
my $val = $a->[$i];
if ( $val == $val_to_remove ) {
splice #$a, $i, 1;
last;
}
}
}
}
This seems, to say the least, a little awkward using two for loops.
Is it possible to simplify this?
I also tried
use strict;
use warnings;
my #a = (1, 2, 3, 6);
my $temp = \#a;
func2 (\$temp );
sub func2 {
my $a = shift;
$$a = [2, 6];
}
but then #a is not modified, but rather $temp will be..
I would also rather like to avoid passing a reference to a reference, since that will mess up the calling syntax for other modules.

Answer 1

Use a hash as an indicator function for identifying efficiently the items to be removed; use a grep for filtering them out:
sub func1 {
my $a = shift;
my %b = map { ($_ => 1) } (2, 6);
#$a = grep { !$b{$_} } #$a;
}

Answer 2

Loic's solution works well and is quite readable. I would recommend it unless you're working with large arrays that cause the grep to eat a lot of memory, or if performance is absolutely critical.
You can get a bit of a performance boost by using splice:
use strict;
use warnings;
use Data::Dump;
my #haystack = (1, 2, 3, 6);
my %needle = map { $_ => 1 } (2, 6);
foreach my $i (reverse 0 .. $#haystack) {
splice #haystack, $i, 1 if exists $needle{ $haystack[$i] };
}
dd \#haystack;
Output:
[1, 3]
Note that you must iterate through #haystack in reverse order, since every time you remove an element, the remaining elements shift to the left, changing the array indexes.
Benchmark
Here are the results from a slightly modified version of BrowserUk's corrected benchmark, written in response to foreach array - delete current row ? on PerlMonks. The original benchmark included several other methods for removing elements from an array, which I've left out for simplicity.
$ ./benchmark -N=1e2
Rate grep for_splice
grep 40959/s -- -37%
for_splice 65164/s 59% --
$ ./benchmark -N=1e3
Rate grep for_splice
grep 4072/s -- -38%
for_splice 6515/s 60% --
$ ./benchmark -N=1e4
Rate grep for_splice
grep 366/s -- -33%
for_splice 550/s 50% --
$ ./benchmark -N=1e5
Rate grep for_splice
grep 32.7/s -- -38%
for_splice 52.9/s 62% --
$ ./benchmark -N=1e6
(warning: too few iterations for a reliable count)
Rate grep for_splice
grep 2.36/s -- -28%
for_splice 3.28/s 39% --
And the benchmark code itself:
#!/usr/bin/perl -sl
use strict;
use warnings;
use Benchmark 'cmpthese';
our $N //= 1e3;
our $I //= -1;
# 10% the size of the haystack
my $num_needles = int($N / 10) || 1;
our #as;
#{ $as[ $_ ] } = 1 .. $N for 0 .. 4;
our %needle = map { int(rand($N)) => 1 } 1 .. $num_needles;
cmpthese $I, {
for_splice => q[
my $ar = $as[0];
foreach my $i (reverse 0 .. $#$ar) {
splice #$ar, $i, 1 if exists $needle{ $ar->[$i] };
}
$I == 1 and print "0: ", "#$ar";
],
grep => q[
my $ar = $as[1];
#$ar = grep { ! exists $needle{$_} } #$ar;
$I == 1 and print "1: ", "#$ar";
],
};

Answer 3

You can't use a simple for (LIST) loop to iterate over the indices of an array if you're also modifying the contents of the array. That's because the index of the last item may change, and you will also skip over elements if you delete the current element and increment the counter.
A while loop is required instead, or the equivalent C-style for.
This program demonstrates, as well as uing List::Util::any to check whether an array elemnent should be deleted
use strict;
use warnings;
use List::Util 'any';
my #a = (1, 2, 3, 6);
func1 (\#a);
use Data::Dump;
dd \#a;
sub func1 {
my ($a) = #_;
my #b = (2, 6);
for ( my $i = 0; $i < #$a; ) {
if ( any { $a->[$i] == $_ } #b ) {
splice #$a, $i, 1;
}
else {
++$i;
}
}
}
output
[1, 3]

Answer 4

With problems of this nature, it is often easier to build the array you want rather than delete from an existing one.
my #a = ( 1, 2, 3, 6 );
sub func1 {
my $aref = shift #_;
my #b = ( 2, 6 );
my #results = ();
for my $item ( #$aref ){
if( grep { $item == $_ } #b ){
next;
}
push #results, $item;
}
return #results;
}
my #results = func1( \#a );
say "#results";