在Perl中，最快的递增字符串的方法是什么？

Question

我希望能够在perl中以快速的方式在循环内附加字符串，而不必为每次迭代复制字符串。我正在寻找类似于Java或C＃中的StringBuilder的东西。

我目前知道以下替代方案，以执行'a += b'。

1. a .= b #连接 2. a = join('', a, b); #连接 3. push @a, b #数组推送

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

这里是一个链接到我正在尝试解决的问题Here is a link，虽然略有不同。

- André Pontes

---

你考虑过使用s/([a-z])\1+/($+[0] - $-[0]) . $1/eg吗？ - melpomene

如果你有 aabbaa，你会将其压缩成 2a2b2a 还是 4a2b？ - Håkon Hægland

如果我有aabbaa，则应将其压缩为2a2b2a。 - André Pontes

如果你有一个单字符abb，你会使用1还是不用，例如1a2b或a2b？ - Håkon Hægland

如果你只有一个字符，就不需要使用压缩。所以 compress('aaabcddd') = '3abc3d'。 ;) - André Pontes

是的，这很有道理，否则就不会是一种压缩了。对于两个字符来说，由于“aa”和“2a”的长度相同，所以不会进行压缩。 - Håkon Hægland

Answer 1

为了比较，我尝试测试不同版本来解决您的实际问题，即压缩字符串。这是我的测试脚本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;
}

这里的compress_c.c是指：

SV *compress_c(SV* str_sv) {
    STRLEN len;
    char* str = SvPVbyte(str_sv, len);

    SV* result = newSV(len);
    char *buf = SvPVX(result);

    char prev = str[0];
    int count = 1;
    int j = 0;
    int i;
    for (i = 1; i < len; i++ )
    {
    char cur = str[i];
        if ( prev == cur ) {
            count++;
            if ( i < (len - 1) )
                continue;
        }

        if ( count > 1) {
            buf[j++] = count + '0';  // assume count is less than 10
        }

        buf[j++] = prev;
        if ( (i == (len - 1)) && (prev != cur) ) buf[j++] = cur;
        count = 1;
        prev = cur;
    }

    buf[j] = '\0';
    SvPOK_on(result);
    SvCUR_set(result, j);
    return result;
}

运行perl test.pl的结果：

                  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笔记本电脑(Intel Core i7-7500U CPU @ 2.70GHz)上进行了测试。

- Håkon Hægland

---

@ikegami 感谢您的修改和评论！我想知道如何摆脱malloc调用，以便不必分配两次缓冲区。我有一些问题：1.当我们使用SvPVbyte(str_sv, len)时，是否需要SvGETMAGIC(str_sv)？根据perlapi SvPV()处理获取魔法。2.SvGETMAGIC()后面的大括号块为什么？我看不出在这里添加本地范围的任何原因。3.您在答案修订历史记录中所说的“已删除Unicode错误”是什么意思？ - Håkon Hægland

4. 还有注释中的“修复了编译错误（for 循环内部的 int）”。在 C99 中，在 for 循环规范中声明变量是有效的，请参见此答案。

- Håkon Hægland

我已经在这里提交了原始问题的基准测试，该问题稍有不同。 尽管如此，我已获得相同的结果。 - André Pontes

1. 哎呀，你说的 SvPVbyte 已经包含了 SvGETMAGIC 的功能是对的。
2. 根据 C 的版本，你不能混合声明和代码。变量声明只能在块的开头或另一个变量声明之后找到。
3. 我（实际上）用 SvPVbytes 替换了 SvPV。你不能使用 SvPV 而不单独检查 UTF8 标志。
4. 将 gcc 切换到 C99 模式需要一个开关，但我的 perl 构建时没有使用它。

- ikegami

Answer 2

我已经进行了多种基准测试来验证以下内容：

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

- André Pontes

---

你的 "list prealloc" 例子并没有预分配一个数组。它只分配了一个单独的元素，这个元素是一个很长的字符串。 - melpomene

在我看来，最好对整个问题进行基准测试 - 例如，在字符串中计算字符出现的次数。 - clt60

我在我的Ubuntu 16.10笔记本电脑(Intel Core i7-7500U CPU @ 2.70GHz)上进行了测试，并得到了类似的结果。我删除了对substr的调用，并将其替换为一个常量1个字符的字符串。现在，concat是最快的，速度为3229/s。我还使用预分配实现了一个C版本(使用Inline::C)，它比concat版本快大约90倍(284350/s)。我删除substr调用的原因是为了更容易地将C版本与Perl版本进行比较。 - Håkon Hægland

melpomene: 现在我明白了。' ' x length($dna) 是一个字符串。我已经用 (' ') x length($dna) 修复了它，这将预分配数组。基准测试结果的顺序相同。 - André Pontes