user1550596
user1550596

Reputation: 25

Perl remove same value back to back with splice

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

Answers (2)

zdim
zdim

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

choroba
choroba

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 with splice. 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

Related Questions