Кластеризовать (группировать) массив строк

Question

Мне нужно сгруппировать массив строк следующим образом (объединить те же строки рядом)

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

Как это сделать?

Я написал этот код

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

Но это не работает, как ожидалось, вывод fold_list() равен

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

Я полагаю, что проблема в str_minus_multiplier($x[$i]) eq $x[$i+$j] сравнении, после сращивания одно значение в сравнении - undef. Как этого избежать?

Answer 1

Другой Perl - использование обратной ссылки

$ echo "aaabccdcx"| perl -nle ' while( /(.)(\1*)/g ) { $t=length("$1$2"); print "$1 -> ",$t> 1? "x(".$t.")" : "" } '
a -> x(3)
b ->
c -> x(2)
d ->
c ->
x ->
$

автономный

$  perl -le ' $str="aaabccdcx"; while($str=~/(.)(\1*)/g ) { $t=length("$1$2"); print "$1 -> ",$t> 1? "x(".$t.")" : "" } '
a -> x(3)
b ->
c -> x(2)
d ->
c ->
x ->
$

Answer 2

Возможно, вы слишком усложняете проблему.По сути, это вариант кодировки длины прогона .

Идея состоит в том, чтобы пройтись по списку и увеличить счетчик для каждого символа, чтобы вычислить длительность «прогона», илисколько последующих символов равно текущему символу.Как только вы нашли длину, добавьте ее к результату в соответствующем формате и пропустите все элементы, которые вы только что сдвинули вместе.

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;

Вывод:

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

Answer 3

Кажется, это делает то, что вы хотите. Это длиннее других ответов, но (надеюсь) менее загадочно.

#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

my $string = 'aaabccdcx';

my $prev = '';
my $count;
my @out;

for (split //, $string) {
  if ($_ eq $prev) {
    $count++;
  } else {
    push @out, $prev . ($count > 1 ? " (x$count)" : '') if $count;
    $count = 1;
    $prev = $_;
  }
}

push @out, $prev . ($count > 1 ? " (x$count)" : '');

print Dumper \@out;

Answer 4

Множество способов сделать это, у меня есть:

$ cat file1
'a'
'a'
'a'
'b'
'c'
'c'
'd'
'x'

$ perl -ne 'END{for(sort keys %count){if($count{$_}>1){ print "$_ \(x$count{$_}\)\n";} else{print "$_\n";}}} chomp; $count{$_}++;' file1
'a' (x3)
'b'
'c' (x2)
'd'
'x'