String 在perl中增加字符串的最快方法是什么？

我想以一种快速的方式在循环中附加一个perl字符串，而不必为每次迭代复制字符串。我想从Java或C#中寻找类似StringBuilder的东西

目前，为了实现“a+=b”，我考虑了以下备选方案

a.=b#concat

a=连接（“”，a，b）#加入

推动@a，b#阵列推动

我对将所有字符串复制到另一个字符串不感兴趣。我每次需要复制一个字符，或者在每次迭代中附加小字符串。我试图解决以下问题：将输入字符串“aaabbcc”压缩为“3a2b3c”。因此，我们的想法是迭代输入字符串，检查有多少重复字符，然后以压缩的方式追加到输出中。在perl中执行此操作最有效的方法是什么

---

我试图解决的问题。不过我有点不同。

我已经用几种方法执行了以下基准测试：

#!/usr/bin/perl
use strict;
use warnings;
use Benchmark qw(cmpthese);

my $dna;
$dna .= [qw(G A T C)]->[rand 4] for 1 .. 10000;

sub frequency_concat {
    my $result = '';

    for my $idx (0 .. length($dna) - 1) {
            $result .= substr($dna, $idx, 1);
    }

    return $result;
 }

 sub frequency_join {
    my $result = '';

    for my $idx (0 .. length($dna) - 1) {
            $result = join '', $result, substr($dna,$idx,1);
    }

    return $result;
}

sub frequency_list_push {
       my @result = ();

       for my $idx (0 .. length($dna) - 1) {
               push @result, substr($dna,$idx,1);
       }

       return join '', @result;
 }

 sub frequency_list_prealloc {
            my @result = (' ' x length($dna));

            for my $idx (0 .. length($dna) - 1) {
                    $result[$idx] = substr($dna,$idx,1);
            }

            return join '', @result;
 }


cmpthese(-1, # Run each for at least 1 second(s)   {
               concat => \&frequency_concat,
               join => \&frequency_join,
               list_push => \&frequency_list_push,
               list_list_prealloc => \&frequency_list_prealloc
       }
   );

下面的结果表明，concat（a.b）是最快的操作。我不明白为什么，因为这需要制作多个字符串副本

                    Rate         join   list_push list_list_prealloc          concat
join               213/s           --        -38%               -41%        -74%
list_push          342/s          60%          --                -5%        -58%
list_list_prealloc 359/s          68%          5%                 --        -56%
concat             822/s         285%        140%               129%          --

---

为了比较，我尝试测试不同的版本来解决压缩字符串的实际问题。这是我的测试脚本

test.pl

：

use strict;
use warnings;

use Benchmark qw(cmpthese);
use Inline C => './compress_c.c';

my $str_len = 10000;
my @chars = qw(a b c d);
my $str;
$str .= [@chars]->[rand 4] for 1 .. $str_len;

cmpthese(
    -1,
    {
        compress_array => sub { compress_array( $str ) },
        compress_regex => sub { compress_regex( $str ) },
        compress_str   => sub { compress_str( $str ) },
        compress_c     => sub { compress_c( $str ) },
    }
);

# Suggested by @melpomene in the comments   
sub compress_regex {
    return $_[0] =~ s/([a-z])\1+/($+[0] - $-[0]) . $1/egr;
}

sub compress_array {
    my $result = '';

    my @chrs = split //, $_[0];

    my $prev = $chrs[0];
    my $count = 1;
    my @result;
    for my $i ( 1..$#chrs ) {
        my $char = $chrs[$i];
        if ( $prev eq $char ) {
            $count++;
            next if $i < $#chrs;
        }
        if ( $count > 1) {
            push @result, $count, $prev;
        }
        else {
            push @result, $prev;
        }
        if ( ( $i == $#chrs ) and ( $prev ne $char ) ) {
            push @result, $char;
            last;
        }
        $count = 1;
        $prev = $char;
    }

    return join '', @result;
}

sub compress_str {
    my $result = '';
    my $prev = substr $_[0], 0, 1;
    my $count = 1;
    my $lastind = (length $_[0]) - 1;
    for my $i (1 .. $lastind) {
        my $char = substr $_[0], $i, 1;
        if ( $prev eq $char ) {
            $count++;
            next if $i < $lastind;
        }

        if ( $count > 1) {
            $result .= $count;
        }
        $result .= $prev;
        if ( ( $i == $lastind ) and ( $prev ne $char ) ) {
            $result .= $char;
            last;
        }
        $count = 1;
        $prev = $char;
    }

    return $result;
}

                  Rate compress_array  compress_str compress_regex    compress_c
compress_array   311/s             --          -42%           -45%          -99%
compress_str     533/s            71%            --            -6%          -98%
compress_regex   570/s            83%            7%             --          -98%
compress_c     30632/s          9746%         5644%          5273%            --

运行

perl test.pl

的结果：

use strict;
use warnings;

use Benchmark qw(cmpthese);
use Inline C => './compress_c.c';

my $str_len = 10000;
my @chars = qw(a b c d);
my $str;
$str .= [@chars]->[rand 4] for 1 .. $str_len;

cmpthese(
    -1,
    {
        compress_array => sub { compress_array( $str ) },
        compress_regex => sub { compress_regex( $str ) },
        compress_str   => sub { compress_str( $str ) },
        compress_c     => sub { compress_c( $str ) },
    }
);

# Suggested by @melpomene in the comments   
sub compress_regex {
    return $_[0] =~ s/([a-z])\1+/($+[0] - $-[0]) . $1/egr;
}

sub compress_array {
    my $result = '';

    my @chrs = split //, $_[0];

    my $prev = $chrs[0];
    my $count = 1;
    my @result;
    for my $i ( 1..$#chrs ) {
        my $char = $chrs[$i];
        if ( $prev eq $char ) {
            $count++;
            next if $i < $#chrs;
        }
        if ( $count > 1) {
            push @result, $count, $prev;
        }
        else {
            push @result, $prev;
        }
        if ( ( $i == $#chrs ) and ( $prev ne $char ) ) {
            push @result, $char;
            last;
        }
        $count = 1;
        $prev = $char;
    }

    return join '', @result;
}

sub compress_str {
    my $result = '';
    my $prev = substr $_[0], 0, 1;
    my $count = 1;
    my $lastind = (length $_[0]) - 1;
    for my $i (1 .. $lastind) {
        my $char = substr $_[0], $i, 1;
        if ( $prev eq $char ) {
            $count++;
            next if $i < $lastind;
        }

        if ( $count > 1) {
            $result .= $count;
        }
        $result .= $prev;
        if ( ( $i == $lastind ) and ( $prev ne $char ) ) {
            $result .= $char;
            last;
        }
        $count = 1;
        $prev = $char;
    }

    return $result;
}

                  Rate compress_array  compress_str compress_regex    compress_c
compress_array   311/s             --          -42%           -45%          -99%
compress_str     533/s            71%            --            -6%          -98%
compress_regex   570/s            83%            7%             --          -98%
compress_c     30632/s          9746%         5644%          5273%            --

这表明正则表达式版本比字符串版本稍快。然而，C版本是最快的，大约是正则表达式版本的50倍

---

注意：我在我的Ubuntu 16.10笔记本电脑（英特尔Core i7-7500U CPU@2.70GHz）上测试了这一点。

您的“列表预分配”案例没有预分配阵列。它只分配一个元素，这是一个长字符串。IMHO可以更好地对整个问题进行基准测试-例如，计算字符串中某个字符的出现次数。我在我的Ubuntu 16.10笔记本电脑（Intel Core i7-7500U CPU@2.70GHz）上测试了这一点，并得到了类似的结果。我删除了对

substr

的调用，取而代之的是一个常量1字符字符串。现在，

concat

速度最快，为3229/s。我还实现了一个带有预分配（使用）的C版本，其速度大约是

concat

版本（284350/s）的90倍。我删除

substr

调用的原因是为了能够更容易地将C版本与Perl版本进行比较x长度（$dna）是一个字符串。我已经用（''）x长度（$dna）修复了它，这将预先分配数组。基准测试结果的顺序相同。您是否考虑过

s/（[a-z]）\1+/（$+[0]-$-[0]）$1/eg

？如果你有

aabbaa

你会把它压缩到

2a2b2a

还是

4a2b

？如果我有aabbaa，那么它应该压缩到2a2b2a。好：）如果你有单字符

abb

你会使用1还是什么都不用，即

1a2b

或

a2b

？如果你有单字符，什么都不用。所以压缩（'aaabcddd'）='3abc3d'。）@ikegami感谢您的编辑和评论！我想知道如何摆脱

malloc

调用，这样我就不必分配两次缓冲区了。我有一些问题：1。当我们使用

SvPVbyte（str\u sv，len）

时，是否需要

SvGETMAGIC（str\u sv）

？根据

SvPV（）。2.为什么在
SvGETMAGIC（）
之后加括号的块？我看不出有任何理由在这里添加本地作用域。3.“删除Unicode错误”（答案修订历史记录中的注释）是什么意思？。。。4.注释“修复了
for
的
内部的编译错误（
int
）”。对于C99中的
循环规范，在
中声明变量应该是有效的，请参阅。我已经为我试图解决的原始问题提供了基准测试。这是一个稍微不同的问题。不过我得到了同样的结果。哎呀，关于
SvPVbyte
你说得对，你已经在做
SvGETMAGIC
。2.根据C的版本，不能混合声明和代码。Var声明只能在一个块的开头或另一个Var声明之后找到。3.我（有效地）用SvPVbytes替换了SvPV。如果不单独检查
UTF8
标志，则无法使用SvPV。4.将
gcc
切换到C99模式需要一个在构建my
perl
时未使用的开关。