Clusterize (group) array of strings

Question

I need to group array of strings following way (merge same strings nearby)

Input          | Output
---------------+--------------------
[              | [
    'a'        |    'a (x3)',
    'a'        |    'b',
    'a'        |    'c (x2)'
    'b'        |    'd'
    'c'        |    'c'
    'c'        |    'x'
    'd'        | ]
    'c'        |
    'x'        |
]              |
---------------+--------------------

How to do that ?

I wrote this code

sub str_minus_multiplier {
    my ( $str ) = @_;
    $str =~ s/\(x(\d+)\)//;
    return $str;
}

sub str_add_multiplier {
    my ( $str, $num ) = @_;
    $num = 1 if !defined $num;
    if ( my $n = str_has_multiplier($str) ) {
        $str = str_minus_multiplier($str);
        my $new_m = $n+$num;
        $str.= '(x'.$new_m.')';
    } else {
        $str.= ' (x2)';
    }
    return $str;
}

sub fold_list {
    my ( @x ) = @_;
    for my $i (0 .. $#x-1) {

        my $j = 1;
        while ( str_minus_multiplier($x[$i]) eq $x[$i+$j] ) {
            $x[$i] = str_add_multiplier($x[$i]);
            $j++;
        }
        splice(@x, $i+1, $j-1) if ( $j > 1 );
    }
    return @x;
}

But it's not working as expected, output of fold_list() is

[
          'a (x2)',
          'a',
          'b',
          'c (x2)',
          'd',
          'c',
          'x',
          ' (x2)'
        ];

I guess that problem is in str_minus_multiplier($x[$i]) eq $x[$i+$j] comparision, after splice one value in comparision is undef. How to avoid that ?

Answer 1

You may be overcomplicating the problem. Essentially, this is a variant of run-length encoding.

The idea is to walk through the list and increment a counter at each character to compute how long the "run" is, or how many subsequent characters are equal to the current character. Once you've found the length, add it to the result in the appropriate format and skip all of the elements you just squashed together.

use strict;
use warnings;
use Data::Dumper;

my @a = split //, "aaabccdcx";
my @rle;

for (my $i = 0; $i < @a;) {
    my $j = 1;

    while ($i + $j < @a && $a[$i+$j] eq $a[$i]) {
        $j++;
    }

    push @rle, $a[$i] . ($j > 1 ? " (x$j)" : "");
    $i += $j;
}

print Dumper \@rle;

Output:

$VAR1 = [
          'a (x3)',
          'b',
          'c (x2)',
          'd',
          'c',
          'x'
        ];