Question

我正在创建一个Perl脚本，它必须处理数百万条维基百科文章的标记 - 所以速度是一个问题。

我正在寻找的其中一件事是模板的出现，它们总是如下所示：{{template}}。因为这些可能是复杂和嵌套的，我需要分别找到开始和结束标记，并知道找到它们的字符索引。

所以这里有一些简单的代码（假设$ text是包含模板的文本）：

my $matchIndex ;

my $startCount = 0 ;
my $endCount = 0 ;

# find all occurrences of template start and template end tags
while($text =~ m/(\{\{)|(\}\})/gs) {

    $matchIndex = $+[0] ;

    if (defined $1) {
        #this is the start of a template
        $startCount ++ ;
    } else {
        #this is the end of a template
        $endCount++ ;
    }
 }

这段代码真的很奇怪的是$matchIndex = $+[0] ;行对效率产生了巨大的影响，即使它只是查找数组中的值。如果没有这个注释，一个复杂的维基百科文章（包含2000个模板 - 疯狂但它发生）将在0m0.080s内处理。保持它在那里颠簸时间达到0m2.646s。怎么了？

也许这听起来像是在分裂头发，但这是在几小时内处理维基百科或在几周内处理维基百科之间的区别。

Answer 1

为什么使用正则表达式？您正在寻找文字{{或}}的位置。 Perl有一个内置的功能：index。

由于您尝试解析Wikipedia条目，因此需要处理嵌套模板指令。这意味着，例如，您找到的第二组闭合曲线不一定与第二组开放曲线一起使用。在Perl条目的这一位中，第一个结束卷曲与第二个开头卷曲：

{{Infobox programming language
| latest_release_version = 5.10.0
| latest_release_date    = {{release date|mf=yes|2007|12|18}}
| turing-complete        = Yes
}}

Perl 5.10正则表达式可以为您处理这个问题，因为它们可以递归地匹配平衡文本，并且还有Perl模块可以执行此操作。不过，这将是一项工作。在你说出你想要完成的事情之前，很难给你任何建议。当然有一个mediawiki解析器可以做你想做的事情。

我打算编写我的index()解决方案，但我没有。我无法让你的代码变得足够慢以至于重要。即使我执行所有堆栈管理并打印每个模板的内容，pos()和@-解决方案对我来说几乎都是完整的。我必须非常努力地让它运行得足够慢以便可测量，而且我在一些旧的硬件上。您可能需要以其他方式调整应用程序。

您确定要测量的代码在您认为的那个点上正在减慢吗？您是否使用Devel::NYTProf对其进行了分析，以了解您的真实计划正在做什么？

#!/usr/bin/perl
use strict;
use warnings;

use Benchmark;

my $text = do { local $/; <DATA> }; # put the contents after __END__

my %subs = (
    using_pos     => sub {
        my $page = shift;

        my @stack;
        my $found;
        while( $$page =~ m/ ( \{\{ | }} ) /xg ) {           
            if( $1 eq '{{' ) { push @stack, pos($$page) - 2; }
            else             
                { 
                my $start = pop @stack;
                print STDERR "\tFound at $start: ", substr( $$page, $start, pos($$page) - $start ), "\n";
                $found++;
                };
            }

        print " Processed $found templates => ";
        },

    using_special => sub {
        my $page = shift;

        my @stack;
        my $found;
        while( $$page =~ m/ ( \{\{ | }} ) /xg ) {           
            if( $1 eq '{{' ) { push @stack, $-[0]; }
            else             
                { 
                my $start = pop @stack;
                print STDERR "\tFound at $start: ", substr( $$page, $start, $-[0] - $start ), "\n";
                $found++;
                };
            }

        print " Processed $found templates => ";
        },

    );

foreach my $key ( keys %subs )
    {
    printf "%15s => ", $key;

    my $t = timeit( 1, sub{ $subs{$key}->( \$text ) } );
    print timestr($t), "\n";
    }

我的17英寸MacBook Pro上的perl：

macbookpro_brian[349]$ perl -V
Summary of my perl5 (revision 5 version 8 subversion 8) configuration:
  Platform:
    osname=darwin, osvers=8.8.2, archname=darwin-2level
    uname='darwin macbookpro.local 8.8.2 darwin kernel version 8.8.2: thu sep 28 20:43:26 pdt 2006; root:xnu-792.14.14.obj~1release_i386 i386 i386 '
    config_args='-des'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cc', ccflags ='-fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -I/opt/local/include',
    optimize='-O3',
    cppflags='-no-cpp-precomp -fno-common -DPERL_DARWIN -no-cpp-precomp -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include -I/opt/local/include'
    ccversion='', gccversion='4.0.1 (Apple Computer, Inc. build 5363)', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='env MACOSX_DEPLOYMENT_TARGET=10.3 cc', ldflags =' -L/usr/local/lib -L/opt/local/lib'
    libpth=/usr/local/lib /opt/local/lib /usr/lib
    libs=-ldbm -ldl -lm -lc
    perllibs=-ldl -lm -lc
    libc=/usr/lib/libc.dylib, so=dylib, useshrplib=false, libperl=libperl.a
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=bundle, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags=' -bundle -undefined dynamic_lookup -L/usr/local/lib -L/opt/local/lib'


Characteristics of this binary (from libperl): 
  Compile-time options: PERL_MALLOC_WRAP USE_LARGE_FILES USE_PERLIO
  Built under darwin
  Compiled at Apr  9 2007 10:36:26
  @INC:
    /usr/local/lib/perl5/5.8.8/darwin-2level
    /usr/local/lib/perl5/5.8.8
    /usr/local/lib/perl5/site_perl/5.8.8/darwin-2level
    /usr/local/lib/perl5/site_perl/5.8.8
    /usr/local/lib/perl5/site_perl

Answer 2

更新

你的时间安排有点怀疑：

#!/usr/bin/perl

use strict;
use warnings;

my $text = '{{abcdefg}}' x 100_000;

my @match_pos;
my ($start_count, $end_count);

while ( $text =~ /({{)|(}})/g ) {
    push @match_pos, $-[0];
    if ( defined $1 ) {
        ++$start_count;
    }
    else {
        ++$end_count;
    }
}

让我们时间吧：

C:\Temp> timethis zxc.pl

TimeThis :  Command Line :  zxc.pl
TimeThis :  Elapsed Time :  00:00:00.985

用$-[0]替换length $`需要很长时间才能完成（我在一分钟后按 CTRL-C ）。

如果我制作上述简单图案的2_000份副本，则时间最终相同（大约0.2秒）。因此，我建议使用$-[0]来实现可伸缩性。

之前的讨论

来自perldoc perlvar：

# @LAST_MATCH_START
# @-

$-[0]是上次成功比赛开始的偏移量。 $-[n]是与第n个匹配的子字符串的开头的偏移量 subpattern，如果子模式不匹配，则为undef。

另见@+。

正则表达式中的s选项是不必要的，因为模式中没有.。

你看过Text::Balanced吗？

您也可以使用pos，但我不确定它是否能满足您的性能要求。

#!/usr/bin/perl

use strict;
use warnings;

use File::Slurp;

my $text = read_file \*DATA;

my @match_pos;
my ($start_count, $end_count);

while ( $text =~ /({{)|(}})/g ) {
    push @match_pos, pos($text) - 2;
    # push @match_pos, $-[0]; # seems to be slightly faster
    if ( defined $1 ) {
        ++$start_count;
    }
    else {
        ++$end_count;
    }
}

for my $i ( @match_pos ) {
    print substr($text, $i, 2), "\n";
}

__DATA__
Copy & paste the source of the complicated Wikipedia page here to test.

Answer 3

$+[0] 不只是一个数组查找;它使用魔术界面深入研究正则表达式结果结构以查找所需的值。但我很难相信2000次迭代需要2秒。你能发布一个实际的基准吗？

你是否按照SinanÜnür的建议尝试使用pos？

更新：我发现字节偏移和字符偏移（应该有效地缓存）之间的转换可能会降低您的性能。尝试运行utf8 :: encode（）最初在你的字符串上，如果需要，然后在各个捕获的文本片段上使用utf8 :: decode。

Answer 4

除非您在维基百科服务器上运行它，否则网络延迟将比调整脚本更重要，即便如此，它也将是边缘的。

The MediaWiki API和CPAN JSON module可能对您有用，具体取决于您当前要做的事情。

有没有快速的方法来获得正则表达式匹配的字符索引？

4 个答案:

更新

之前的讨论