我需要按照以下方式对字符串数组进行分组(在附近合并相同的字符串)
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
之后。如何避免呢?
答案 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 ->
$