为什么Perl的tr / \ n //会随着行长的增加而变得越来越慢?

在perlfaq5中,如何计算文件中的行数有一个答案。 目前的答案建议sysreadtr/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 linesn";
    #                       },
                   "$file-$count" => sub { 
                        open my( $fh ), '<', $file; 
                        my $count = 0;
                        while(<$fh>) { $count++ } 
                        print $outfh "$count found $count linesn";
                        },
                   "$file-$."     => sub { 
                        open my( $fh ), '<', $file; 
                        1 while(<$fh>); 
                        print $outfh "$. found $. linesn";
                        },
                   "$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 linen";
                        },
                   "$file-wc"       => sub { 
                        my $lines = `wc -l $file`;
                        chomp( $lines );
                        print $outfh "wc found $lines linen";
                        },
                        }
               );   
         }
    
    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;
        }
    

    我想知道我们使用的基准是否有太多的运动部件:我们正在处理不同大小的数据文件,使用不同的线路长度,并试图测量tr相对于其竞争对手的速度 - 与潜在的(但未经测试的)假设tr是性能随着线长变化的方法。

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

    然后它给我留下了深刻的印象:如果tr是稳定的参考点,而其他方法是随着线的大小而变化的呢? 当你看着你的飞船窗口,是你还是那个克林贡鸟正在移动?

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

  • tr是对线长变化最不敏感的方法。 由于所测试的所有三个行长度(短,中,长)所处理的字节总数N是恒定的,这意味着tr在编辑它所给出的字符串时非常有效。 即使短线数据文件需要更多的编辑, tr方法也能够处理数据文件,几乎与处理长文件文件一样快。
  • 随着线条变长,依赖<>的方法加速,尽管速度在减小。 这是有道理的:由于每次调用<>需要一些工作,因此使用较短的行处理给定的N个字节(至少在测试范围内)应该较慢。
  • s///方法对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 linesn";
        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 $nn";
        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 $nn";
        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/ $nn";
        close $data_fh;
    }
    

    更新回应Brad的评论。 我尝试了所有三种变体,它们的行为大致类似于s/n//g - 对于较短行的数据文件较慢(具有s/(n)/$1/更慢的其他限制) 。 有趣的部分是, m/n/gs/n//g速度基本相同,这表明正则表达式方法( s///m// )的缓慢不直接依赖于编辑字符串的问题。


    我也看到tr///相对较慢,因为线长度增加,但效果并不显着。 这些结果来自Windows 7 x64上的ActivePerl 5.10.1(32位)。 我还得到了“可靠计数的迭代次数太少”的警告,因此我将迭代次数提高到了500次。

            VL: 4501.06    288
            LO: 749.25     29
            SH: 69.38      6
            VA: 104.66     55
                Rate VL-$count     VL-$.     VL-tr      VL-s     VL-wc
    VL-$count 2.82/s        --       -0%      -52%      -56%      -99%
    VL-$.     2.83/s        0%        --      -51%      -56%      -99%
    VL-tr     5.83/s      107%      106%        --      -10%      -99%
    VL-s      6.45/s      129%      128%       11%        --      -99%
    VL-wc      501/s    17655%    17602%     8490%     7656%        --
                Rate LO-$count     LO-$.      LO-s     LO-tr     LO-wc
    LO-$count 16.5/s        --       -1%      -50%      -51%      -97%
    LO-$.     16.8/s        1%        --      -50%      -51%      -97%
    LO-s      33.2/s      101%       98%        --       -3%      -94%
    LO-tr     34.1/s      106%      103%        3%        --      -94%
    LO-wc      583/s     3424%     3374%     1655%     1609%        --
                Rate SH-$count     SH-$.      SH-s     SH-tr     SH-wc
    SH-$count  120/s        --       -7%      -31%      -67%      -81%
    SH-$.      129/s        7%        --      -26%      -65%      -80%
    SH-s       174/s       45%       35%        --      -52%      -73%
    SH-tr      364/s      202%      182%      109%        --      -43%
    SH-wc      642/s      433%      397%      269%       76%        --
                Rate VA-$count     VA-$.      VA-s     VA-tr     VA-wc
    VA-$count 92.6/s        --       -5%      -36%      -63%      -79%
    VA-$.     97.4/s        5%        --      -33%      -61%      -78%
    VA-s       146/s       57%       50%        --      -42%      -67%
    VA-tr      252/s      172%      159%       73%        --      -43%
    VA-wc      439/s      374%      351%      201%       74%        --
    

    编辑:我做了一个修改的基准来比较不同线路长度的费率。 它清楚地表明tr///开始时对于短线条有很大的优势,随着线条变长,这些短线条会迅速消失。 至于为什么发生这种情况,我只能推测tr///针对短字符串进行了优化。

    线数比较http://img69.imageshack.us/img69/6250/linecount.th.png


    长线比短线大约65倍,并且您的数字表明tr / n //运行速度慢65倍。 这是预期的。

    wc显然可以在长线上缩放得更好。 我不知道为什么; 也许是因为它被调整为只计算换行符,尤其是当您使用-l选项时。

    链接地址: http://www.djcxy.com/p/59213.html

    上一篇: Why does Perl's tr/\n// get slower and slower as line lengths increase?

    下一篇: Having problems installing ruby 1.9.3