Home > OS >  Perl remove same value back to back with splice
Perl remove same value back to back with splice

Time:10-20

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?

CodePudding user response:

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} };

CodePudding user response:

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 index, looking up an element and the next (or previous) one, carefully.

I presume that B is just an example but that in fact it can be any value, equal to its adjacent one.

But it's interesting that regex can help, too

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 only a pair (two) of adjacent values, so if there are three equal adjacent values it leaves the odd one (f above).

Single-letter elements are only an example, likely. In general we'd have to join elements with something that can't be in an element, and that is clearly a tricky proposition. But perhaps reasonable is a line-feed, as one can expect to know that 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).


Something like (but hopefully prettier)

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
  • Related