perl - 为什么 Perl 的 tr/\n//随着行长的增加越来越慢？

Question

在 perlfaq5 ，有How do I count the number of lines in a file?的答案.当前答案建议 sysread和 tr/\n// .我想尝试一些其他的东西，看看能快多少 tr/\n//将是，并且还尝试针对具有不同平均行长度的文件。我创建了一个基准来尝试各种方法来做到这一点。我在 MacBook Air 上的 Mac OS X 10.5.8 和 Perl 5.10.1 上运行它:

向 wc 发起攻击(除了短线最快)

tr/\n// (次快，除了较长的平均线长度)

s/\n//g (通常很快)

while( <$fh> ) { $count++ } (几乎总是一个缓慢的戳，除非 tr/// 陷入困境)

1 while( <$fh> ); $. (非常快)

让我们忽略 wc ，即使有了所有 IPC 的东西，它也确实带来了一些有吸引力的数字。

乍一看，它看起来像 tr/\n//当行长很短(比如 100 个字符)时非常好，但当行长变大(一行 1,000 个字符)时，它的性能会下降。线越长越差 tr/\n//做。我的基准测试是否有问题，或者内部是否有其他问题导致 tr///降级？为什么不 s///同样降级？

首先，结果:

                         Rate very_long_lines-tr very_long_lines-$count very_long_lines-$. very_long_lines-s very_long_lines-wc
very_long_lines-tr     1.60/s                 --                   -10%               -12%              -39%               -72%
very_long_lines-$count 1.78/s                11%                     --                -2%              -32%               -69%
very_long_lines-$.     1.82/s                13%                     2%                 --              -31%               -68%
very_long_lines-s      2.64/s                64%                    48%                45%                --               -54%
very_long_lines-wc     5.67/s               253%                   218%               212%              115%                 --
                    Rate long_lines-tr long_lines-$count long_lines-$. long_lines-s long_lines-wc
long_lines-tr     9.56/s            --               -5%           -7%         -30%          -63%
long_lines-$count 10.0/s            5%                --           -2%         -27%          -61%
long_lines-$.     10.2/s            7%                2%            --         -25%          -60%
long_lines-s      13.6/s           43%               36%           33%           --          -47%
long_lines-wc     25.6/s          168%              156%          150%          88%            --
                     Rate short_lines-$count short_lines-s short_lines-$. short_lines-wc short_lines-tr
short_lines-$count 60.2/s                 --           -7%           -11%           -34%           -42%
short_lines-s      64.5/s                 7%            --            -5%           -30%           -38%
short_lines-$.     67.6/s                12%            5%             --           -26%           -35%
short_lines-wc     91.7/s                52%           42%            36%             --           -12%
short_lines-tr      104/s                73%           61%            54%            14%             --
                      Rate varied_lines-$count varied_lines-s varied_lines-$. varied_lines-tr varied_lines-wc
varied_lines-$count 48.8/s                  --            -6%             -8%            -29%            -36%
varied_lines-s      51.8/s                  6%             --             -2%            -24%            -32%
varied_lines-$.     52.9/s                  8%             2%              --            -23%            -30%
varied_lines-tr     68.5/s                 40%            32%             29%              --            -10%
varied_lines-wc     75.8/s                 55%            46%             43%             11%              --

这是基准。我确实有一个控制在那里，但它是如此之快，我只是不理会它。第一次运行它时，基准测试会创建测试文件并打印一些关于它们的行长的统计信息:

use Benchmark qw(cmpthese);
use Statistics::Descriptive;

my @files = create_files();

open my( $outfh ), '>', 'bench-out';

foreach my $file ( @files )
    {
    cmpthese(
        100, {
#               "$file-io-control" => sub { 
#                       open my( $fh ), '<', $file; 
#                   print "Control found 99999 lines\n";
#                       },
               "$file-\$count" => sub { 
                    open my( $fh ), '<', $file; 
                    my $count = 0;
                    while(<$fh>) { $count++ } 
                    print $outfh "\$count found $count lines\n";
                    },
               "$file-\$."     => sub { 
                    open my( $fh ), '<', $file; 
                    1 while(<$fh>); 
                    print $outfh "\$. found $. lines\n";
                    },
               "$file-tr"      => sub { 
                    open my( $fh ), '<', $file; 
                    my $lines = 0;
                    my $buffer;
                    while (sysread $fh, $buffer, 4096) {
                        $lines += ($buffer =~ tr/\n//);
                        }
                    print $outfh "tr found $lines lines \n";
                    },
               "$file-s"       => sub { 
                    open my( $fh ), '<', $file; 
                    my $lines = 0;
                    my $buffer;
                    while (sysread $fh, $buffer, 4096) {
                        $lines += ($buffer =~ s/\n//g);
                        }
                    print $outfh "s found $lines line\n";
                    },
               "$file-wc"       => sub { 
                    my $lines = `wc -l $file`;
                    chomp( $lines );
                    print $outfh "wc found $lines line\n";
                    },
                    }
           );   
     }

sub create_files
    {
            my @names;
    my @files = (
        [ qw( very_long_lines 10000  4000 5000 ) ],
        [ qw( long_lines   10000 700 800 ) ],
        [ qw( short_lines  10000  60  80 ) ],
        [ qw( varied_lines 10000  10 200 ) ],
        );

    foreach my $tuple ( @files )
        {
        push @names, $tuple->[0];
        next if -e $tuple->[0];
        my $stats = create_file( @$tuple );
        printf "%10s: %5.2f  %5.f \n", $tuple->[0], $stats->mean, sqrt( $stats->variance );
        }

    return @names;
    }


sub create_file
    {
    my( $name, $lines, $min, $max ) = @_;

    my $stats = Statistics::Descriptive::Full->new();

    open my( $fh ), '>', $name or die "Could not open $name: $!\n";

    foreach ( 1 .. $lines )
        {
        my $line_length = $min + int rand( $max - $min );
        $stats->add_data( $line_length );
        print $fh 'a' x $line_length, "\n";
        }

    return $stats;
    }

Answer 1

我想知道我们一直在使用的基准测试是否有太多事件部分:我们正在处理不同大小的数据文件，使用不同的行长，并试图衡量 tr 的速度。相对于它的竞争对手——有一个基本的(但未经测试的)假设 tr是性能随行长而变化的方法。

此外，正如布赖恩在一些评论中指出的那样，我们正在喂 tr总是相同大小(4096 字节)的数据缓冲区。如果任何方法应该是不敏感 到行大小，它应该是 tr .

然后我突然想到:如果 tr是稳定的引用点，其他方法是随线条大小变化的吗？当你从飞船的 window 向外看时，是你还是那只克林贡猛禽在移动？

所以我开发了一个保持数据文件大小不变的基准:行长不同，但总字节数保持不变。结果显示:

tr是最不敏感的方法
线长度的变化。自从
处理的总字节数为
所有三个线长的常数
经过测试(短，中，长)，这个
表示 tr在
编辑给定的字符串。甚至
虽然短线数据文件
需要更多编辑，tr方法能够处理数据
文件几乎和它处理文件一样快
长线文件。

依赖 <> 的方法速度
随着线条变长，
虽然以递减的速度。这
有道理:因为每次调用 <>需要一些工作，应该是
处理给定 N 个字节的速度较慢
使用较短的行(至少超过
测试范围)。

s///方法也很敏感
到行长。点赞tr ， 这
方法通过编辑字符串起作用
它是给定的。再次，较短的线
长度意味着更多的编辑。显然，s/// 的能力做出这样的
编辑效率远低于tr .

以下是使用 Perl 5.8.8 在 Solaris 上的结果:

#   ln = $.      <>, then check $.
#   nn = $n      <>, counting lines
#   tr = tr///   using sysread
#   ss = s///    using sysread

#   S = short lines  (50)
#   M = medium lines (500)
#   L = long lines   (5000)

       Rate nn-S
nn-S 1.66/s   --
ln-S 1.81/s   9%
ss-S 2.45/s  48%
nn-M 4.02/s 142%
ln-M 4.07/s 145%
ln-L 4.65/s 180%
nn-L 4.65/s 180%
ss-M 5.85/s 252%
ss-L 7.04/s 324%
tr-S 7.30/s 339%    # tr
tr-L 7.63/s 360%    # tr
tr-M 7.69/s 363%    # tr

Windows ActiveState 的 Perl 5.10.0 上的结果大致相当。

最后，代码:

use strict;
use warnings;
use Set::CrossProduct;
use Benchmark qw(cmpthese);

# Args: file size (in million bytes)
#       N of benchmark iterations
#       true/false (whether to regenerate files)
#
# My results were run with 50 10 1
main(@ARGV);

sub main {
    my ($file_size, $benchmark_n, $regenerate) = @_;
    $file_size *= 1000000;
    my @file_names = create_files($file_size, $regenerate);
    my %methods = (
        ln => \&method_ln,  # $.
        nn => \&method_nn,  # $n
        tr => \&method_tr,  # tr///
        ss => \&method_ss,  # s///
    );
    my $combo_iter = Set::CrossProduct->new([ [keys %methods], \@file_names ]);
    open my $log_fh, '>', 'log.txt';
    my %benchmark_args = map {
        my ($m, $f) = @$_;
        "$m-$f" => sub { $methods{$m}->($f, $log_fh) }
    } $combo_iter->combinations;
    cmpthese($benchmark_n, \%benchmark_args);
    close $log_fh;
}

sub create_files {
    my ($file_size, $regenerate) = @_;
    my %line_lengths = (
        S =>    50,
        M =>   500,
        L =>  5000,
    );
    for my $f (keys %line_lengths){
        next if -f $f and not $regenerate;
        create_file($f, $line_lengths{$f}, $file_size);
    }
    return keys %line_lengths;
}

sub create_file {
    my ($file_name, $line_length, $file_size) = @_;
    my $n_lines = int($file_size / $line_length);
    warn "Generating $file_name with $n_lines lines\n";
    my $line = 'a' x ($line_length - 1);
    chop $line if $^O eq 'MSWin32';
    open(my $fh, '>', $file_name) or die $!;
    print $fh $line, "\n" for 1 .. $n_lines;
    close $fh;
}

sub method_nn {
    my ($data_file, $log_fh) = @_;
    open my $data_fh, '<', $data_file;
    my $n = 0;
    $n ++ while <$data_fh>;
    print $log_fh "$data_file \$n $n\n";
    close $data_fh;
}

sub method_ln {
    my ($data_file, $log_fh) = @_;
    open my $data_fh, '<', $data_file;
    1 while <$data_fh>;
    print $log_fh "$data_file \$. $.\n";
    close $data_fh;
}

sub method_tr {
    my ($data_file, $log_fh) = @_;
    open my $data_fh, '<', $data_file;
    my $n = 0;
    my $buffer;
    while (sysread $data_fh, $buffer, 4096) {
        $n += ($buffer =~ tr/\n//);
    }
    print $log_fh "$data_file tr $n\n";
    close $data_fh;
}

sub method_ss {
    my ($data_file, $log_fh) = @_;
    open my $data_fh, '<', $data_file;
    my $n = 0;
    my $buffer;
    while (sysread $data_fh, $buffer, 4096) {
        $n += ($buffer =~ s/\n//g);
    }
    print $log_fh "$data_file s/ $n\n";
    close $data_fh;
}

更新以回应布拉德的评论。 我尝试了所有三种变体，它们的行为大致类似于 s/\n//g -- 对于较短行的数据文件，速度较慢(附加条件是 s/(\n)/$1/ 甚至比其他文件更慢)。有趣的是 m/\n/g和 s/\n//g的速度基本一样，表明正则表达式方法( s/// 和 m// )的缓慢并不直接取决于编辑字符串的问题。