【发布时间】：2009-12-25 08:21:51
【问题描述】：
在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;
}
【问题讨论】：
-
请分享您的操作系统和 Perl 版本
-
OSX (10.5.8) Perl 5.10.1，我看到的结果类似于 brian 的。但是，我也收到关于“迭代次数太少而无法可靠计数”的重复警告，仅供参考。
-
@brian：今年六月/七月的 MacBookPro。不是那么微不足道，尽管也不是当前的 4GB RAM 型号之一。 （2.26GHz Core2Duo，2 GB RAM，1067MHz，如果重要的话。）这样的结果是否取决于文件系统（部分？）？
-
@Sneakyness：嗯？请参阅我的 cmets 和其他一些人的回复。问题不仅限于一种机器类型。
-
我突然想到
tr///基准测试可能有太多活动部件。随着行越来越长，我们不仅仅是在测试tr///处理长字符串的能力；我们还修改了行长和sysread缓冲区大小之间的相对关系。我对这个问题不是很了解，所以也许这是一个虚假的考虑。但是，如果问题是“tr///使用长字符串会减慢速度吗？”基准测试不应该只关注这一点而不是涉及 IO 问题吗？
标签： perl count benchmarking