集群化(分组)字符串数组

时间:2019-01-17 15:20:35

标签: perl

我需要按照以下方式对字符串数组进行分组(在附近合并相同的字符串)

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之后。如何避免呢?

4 个答案:

答案 0 :(得分:2)

您可能使问题复杂化了。本质上,这是run-length encoding的变体。

这个想法是在列表中遍历,并在每个字符处增加一个计数器,以计算“运行”的时间,或多少个后续字符等于当前字符。找到长度后,以适当的格式将其添加到结果中,然后跳过刚压缩在一起的所有元素。

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'
        ];

答案 1 :(得分:1)

很多方法,我有:

$ 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'

答案 2 :(得分:1)

这似乎可以满足您的要求。它比其他答案更长,但(希望)隐秘程度更低。

#!/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;

答案 3 :(得分: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 ->
$