Reputation: 25
I am trying to remove, the same values twice in an array, it is located back to back, this is my code
@{$tmp_h->{'a'}} = qw/A B B C/;
print Dumper ($tmp_h);
my $j = 0;
foreach my $cur (@{$tmp_h->{'a'}}) {
if ($cur eq 'B') {
splice(@{$tmp_h->{'a'}}, $j, 1);
}
$j++;
}
print Dumper $tmp_h;
However what got is,
$VAR1 = {
'a' => [
'A',
'B',
'B',
'C'
]
};
$VAR1 = {
'a' => [
'A',
'B',
'C'
]
};
I am expecting both 'B' to be removed in this case, what could possibly went wrong?
Upvotes: 0
Views: 115
Reputation: 66899
That code is removing from an array while iterating over it, pulling the carpet from underneath itself; is that necessary?
Instead, iterate and put elements on another array if the adjacent ones aren't equal. So iterate over the index, looking up an element and the next (or previous) one.†
I presume that B
is just an example while in fact it can be any value, equal to its adjacent one.
It's interesting that regex can help too, with its simple way to find repeated patterns using backreferences
my @ary = qw(a b b c d d e f f f g);
my $str_ary = join '', @ary;
$str_ary =~ s/(.)\g{-1}//g;
my @new_ary = split //, $str_ary;
say "@new_ary"; #--> a c e f g
This removes pairs of adjacent values, so if there is an odd number of equal adjacent values it leaves the odd one (f
above). As a curiosity note that it can be written in one statement
my @new_ary = split //, join('', @ary) =~ s/(.)\g{-1}//gr;
The join
-ed array, forming a string, is bound to the substitution operator where /r
modifier is crucial, for allowing this and returning the changed string which is then split back into a list.
To change an array in place have it assign to itself.‡
But single-letter elements are only an example, likely. With multiple characters in elements we can't join them by empty string because we wouldn't know how to split that back into an array; we have to join by something that can't be in any one element, clearly a tricky proposition. A reasonable take is a line-feed, as one can expect to know whether elements are/not multiline strings
my @ary = qw(aa no no way bah bah bah go);
my $str_ary = join "\n", @ary ;
$str_ary =~ s/([^\n]+)\n\g{-1}//g;
my @new = grep { $_ } split /\n/, $str_ary;
say "@new"; #--> aa way bah go
This would still have edge cases with interesting elements, like spaces and empty strings (but then any approach would).
† For example
use warnings;
use strict;
use feature 'say';
my @ary = qw(a b b c d d e f f f g);
my @new_ary;
my $i = 0;
while (++$i <= $#ary) {
if ($ary[$i] ne $ary[$i-1]) {
push @new_ary, $ary[$i-1]
}
else { ++$i }
}
push @new_ary, $ary[-1] if $ary[-1] ne $ary[-2];
say "@new_ary"; #--> a c e f g
‡ Done for the arrayref in the question
@{ $hr->{a} } = qw/A B B C/;
@{$hr->{a}} = split //, join('', @{$hr->{a}}) =~ s/(.)\g{-1}//gr;
say "@{$hr->{a}}"; #--> A C
Upvotes: 4
Reputation: 241988
The Perl documentation tells you in perlsyn under Foreach Loops:
If any part of LIST is an array,
foreach
will get very confused if you add or remove elements within the loop body, for example withsplice
. So don't do that.
You can iterate over the indices instead, but don't forget to not increment the index when removing a value:
#!/usr/bin/perl
use warnings;
use strict;
use Data::Dumper;
my $tmp_h = {a => [qw[ A B B C ]]};
print Dumper($tmp_h);
my $j = 0;
while ($j <= $#{ $tmp_h->{a} }) {
my $cur = $tmp_h->{a}[$j];
if ($cur eq 'B') {
splice @{ $tmp_h->{a} }, $j, 1;
} else {
++$j;
}
}
print Dumper($tmp_h);
Or start from the right so you don't have to worry:
my $j = $#{ $tmp_h->{a} };
while ($j-- >= 0) {
my $cur = $tmp_h->{a}[$j];
splice @{ $tmp_h->{a} }, $j, 1 if $cur eq 'B';
}
But the most straight forward way is to use grep:
@{ $tmp_h->{a} } = grep $_ ne 'B', @{ $tmp_h->{a} };
Upvotes: 2