regex - 为什么我的 Perl 正则表达式这么慢？

Question

我有以下正则表达式:

my $scores_compiled_regex  = qr{^0
                                  \s+
                                  (\p{Alpha}+\d*)
                                  \s+
                                  (\d+
                                  \s*
                                   \p{Alpha}*)
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}                              
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s{2,}
                                   (\d+)?
                                   \s+
                                   \d+ #$
                                   }xos

;

它应该匹配像这样的行(来自一个普通的 txt 文件):

0            AAS  211    1   1       5       2   6                                                                         15

列名是:

0 INST, NAME             A  A-  B+   B  B-  C+   C  C-  D+   D  D-   F  CR   P  PR   I  I*   W  WP  WF  AU  NR  FN  FS

这意味着:分数 A=1、分数 A- = 1、无分数 B+、分数 B=5 等。我正在尝试将它拆分为一个列表，而不是忽略空列，它可以工作，但是非常慢，匹配也非常慢，我的意思是慢，超过 5 秒，有时甚至更多!

文件中的前几个文件如下所示:

0 PALMER, JAN            A  A-  B+   B  B-  C+   C  C-  D+   D  D-   F  CR   P  PR   I  I*   W  WP  WF  AU  NR  FN  FS   TOTAL
0            ECON 103   98      35 114   1  14  75           9      35               1          10       1                     

分数是 A 列右侧的任何内容。

有什么想法吗？谢谢，

Answer 1

查看我的 program :

use strict;
use warnings;

# Column details and sample line, from the post
my $header  = q{0 AOZSVIN, TAMSSZ B      A  A-  B+   B  B-  C+   C  C-  D+   D  D-   F  CR   P  PR   I  I*   W  WP  WF  AU  NR  FN  FS};
my $sample  = q{0            AAS  150   23  25  16  35  45  14   8  10   2   1   1   4                           4                     };
#               -+--------+-----+-----+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---+---..
# chars         1212345678912345612345612341234123412341234123412341234123412341234123412341234123412341234123412341234123412341234...
# num. chars:   2 9        6     6     4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   4   *
my $unpack  = q{A2A9       A6    A6    A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A4  A*};
$unpack =~ s/\s//g;

# Get column names from the "$header" variable above
my @column_names = unpack($unpack, $header);
s/\s+$// for @column_names; # get rid of trailing spaces
s/^\s+// for @column_names; # get rid of leading spaces

# Some sample data in same format, to try the script out
my @samples = (
  q{0            AAS  150   23  25  16  35  45  14   8  10   2   1   1   4                           4                     },
  q{0            AAS  353    2   3   5   2   6       1                   2                                                     },
  q{0            T304 480M   3  10   8   8   2   3   2   1                                               1               1    },
  q{0            BIOS 206    3  14   5  11   9   8   4   8   3   1   1   6                           7                      },
);

my @big_sample = (@samples) ;#x 200_000;

my @unpacked_data_as_arrayrefs;
m    y @unpacked_data_as_hashrefs;
my $begin = time;
for my $line ( @big_sample ) {
    my @data = unpack($unpack,$line);
    s/\s+$// for @data; # get rid of trailing spaces
    s/^\s+// for @data; # get rid of leading spaces
    push @unpacked_data_as_arrayrefs, [@data]; # stop here if this is all you need
    ## below converts the data in a hash, based on the column names given
    #my %as_hash;
    #for ( 0..$#column_names ) {
    #    $as_hash{ $column_names[$_] } = $data[$_];
    #}
    #push @unpacked_data_as_hashrefs, { %as_hash };
}
my $tot = time - $begin;
print "Done in $tot seconds\n";

# verify all data is as we expected
# uncomment the ones that test hashref, if the above hashref-building code is also uncommented.
{
    use Test::More;
    # first sample
    is($unpacked_data_as_arrayrefs[0]->[2],'AAS'); # AAS in the third column
    is($unpacked_data_as_arrayrefs[0]->[7],'35');  # 35 in the 8th column
    # fourth sample
    is($unpacked_data_as_arrayrefs[3]->[2],'BIOS');
    is($unpacked_data_as_arrayrefs[3]->[15],'6');
    # sixth
    is($unpacked_data_as_arrayrefs[5]->[7],'114');
    is($unpacked_data_as_arrayrefs[5]->[10],'75');
    done_testing();
}

它使用 unpack 根据字符串中字段的宽度(以字符为单位)将文本拆分为多个 block 。另请参阅 perlpacktut 以获取有关如何使用 unpack 进行此类字符串修改的更多详细信息。 Unpack 可能是这种格式的最佳选择，因为与正则表达式相比，它的执行速度非常快(在我的机器上大约 6 秒内解析 600_000 个这样的字符串)。

如果您需要了解程序的任何部分，请告诉我。我没有在这里发布它，因为它有点偏长(有评论总比没有好!)。如果您希望我这样做，请告诉我。