regex - 有效地查找作为其他单词子串的单词

Question

我有一个英语单词的 Ispell 列表（近 50 000 个单词），我在 Perl 中的作业是快速（比如不到一分钟）获得所有字符串的列表，这些字符串是其他单词的子字符串。我已经尝试使用两个 foreach 循环比较所有单词的解决方案，但即使进行了一些优化，它仍然太慢。我认为，正确的解决方案可能是在单词数组上巧妙地使用正则表达式。你知道如何快速解决这个问题（在 Perl 中）吗？

score 2 · Accepted Answer

我找到了快速的解决方案，它可以在我的计算机上大约 15 秒内找到所有这些子字符串，只使用一个线程。基本上，对于每个单词，我创建了每个可能的子字符串的数组（消除仅在“s”或“'s”结尾不同的子字符串）：

#take word and return list of all valid substrings
sub split_to_all_valid_subwords {
    my $word = $_[0];
    my @split_list;
    my ($i, $j);
    for ($i = 0; $i < length($word); ++$i){
        for ($j = 1; $j <= length($word) - $i; ++$j){
            unless
                (
                    ($j == length($word)) or
                    ($word =~ m/s$/ and $i == 0 and $j == length($word) - 1) or
                    ($word =~ m/\'s$/ and $i == 0 and $j == length($word) - 2)
                )
                {
                push(@split_list, substr($word, $i, $j));
            }
        }
    }
    return @split_list;
}

然后我只是为子字符串创建所有候选者的列表并与单词相交：

my @substring_candidates;

foreach my $word (@words) {
    push( @substring_candidates, split_to_all_valid_subwords($word));
}

#make intersection between substring candidates and words
my %substring_candidates=map{$_ =>1} @substring_candidates;
my %words=map{$_=>1} @words;
my @substrings = grep( $substring_candidates{$_}, @words );

现在在子字符串中，我有所有单词的数组，它们是其他单词的子字符串。

score 1 · Accepted Answer

Perl 正则表达式将优化模式，如foo|bar|bazAho-Corasick 匹配 - 达到总编译正则表达式长度的某个限制。你的 50000 字可能会超过这个长度，但可以分成更小的组。（实际上，您可能希望将它们按长度分解，并且只检查长度为 N 的单词是否包含长度为 1 到 N-1 的单词。）

或者，您可以在您的 perl 代码中实现 Aho-Corasick - 这很有趣。

score 1 · Accepted Answer

更新

Ondra 在他的回答中提供了一个很好的解决方案；我把我的帖子留在这里作为过度思考问题和优化技术失败的例子。

我最糟糕的情况是出现在输入中与任何其他单词都不匹配的单词。在这种情况下，它是二次的。这OPT_PRESORT是试图宣传大多数单词的最坏情况。这OPT_CONSECUTIVE是一个线性复杂性过滤器，它减少了算法主要部分的项目总数，但在考虑复杂性时它只是一个常数因素。然而，它仍然对 Ondras 算法有用并且节省了几秒钟，因为构建他的拆分列表比比较两个连续的单词更昂贵。

我更新了下面的代码以选择 ondras 算法作为可能的优化。与零线程和预排序优化相结合，它可以产生最大的性能。

我想分享一个我编写的解决方案。给定一个输入文件，它会输出作为同一输入文件中任何其他单词的子字符串的所有单词。因此，它计算的与 ysth 的想法相反，但我从他的回答中采用了优化 #2 的想法。如果需要，可以禁用以下三个主要优化。

多线程
问题“单词 A 在列表 L 中吗？单词 B 在 L 中吗？” 可以很容易地并行化。
对所有单词的长度进行预排序
我创建了一个数组，该数组指向所有可能长度超过某个长度的单词的列表。对于长单词，这可以显着减少可能单词的数量，但它会占用大量空间，因为长度为n的单词出现在从长度为 1 到长度为n的所有列表中。
测试连续单词
在我的/usr/share/dict/words中，大多数连续行看起来非常相似：
```
Abby
Abby's
```
例如。由于每个匹配第一个单词的单词也匹配第二个单词，我立即将第一个单词添加到匹配单词列表中，只保留第二个单词以供进一步测试。这在我的测试用例中节省了大约 30% 的单词。因为我在优化 2 之前就这样做了，所以这也节省了很多空间。另一个权衡是输出不会被排序。

脚本本身大约 120 行长；我在展示之前解释了每个子。

头

这只是多线程的标准脚本头。哦，你需要 perl 5.10 或更高版本才能运行它。配置常量定义优化行为。在该字段中添加您机器的处理器数量。该OPT_MAX变量可以采用您要处理的单词数，但是这是在优化发生后评估的，因此优化已经捕获了简单的单词OPT_CONSECUTIVE。在那里添加任何东西都会使脚本看起来更慢。$|++确保立即显示状态更新。我exit在main被执行后。

#!/usr/bin/perl

use strict; use warnings; use feature qw(say); use threads;
$|=1;

use constant PROCESSORS => 0;   # (false, n) number of threads
use constant OPT_MAX    => 0;    # (false, n) number of words to check
use constant OPT_PRESORT     => 0;  # (true / false) sorts words by length
use constant OPT_CONSECUTIVE => 1;  # (true / false) prefilter data while loading
use constant OPT_ONDRA       => 1;  # select the awesome Ondra algorithm
use constant BLABBER_AT => 10;  # (false, n) print progress at n percent

die q(The optimisations Ondra and Presort are mutually exclusive.)
    if OPT_PRESORT and OPT_ONDRA;

exit main();

`main`

封装主逻辑，做多线程。如果输入已排序，则的输出n words will be matched将大大小于输入单词的数量。在我选择了所有匹配的单词后，我将它们打印到 STDOUT。所有状态更新等都打印到 STDERR，这样它们就不会干扰输出。

sub main {
    my @matching;                       # the matching words.
    my @words = load_words(\@matching); # the words to be searched
    say STDERR 0+@words . " words to be matched";

    my $prepared_words = prepare_words(@words);

    # do the matching, possibly multithreading
    if (PROCESSORS) {
        my @threads =
            map {threads->new(
                    \&test_range,
                    $prepared_words,
                    @words[$$_[0] .. $$_[1]] )
                } divide(PROCESSORS, OPT_MAX || 0+@words);
        push @matching, $_->join for @threads;
    } else {
        push @matching, test_range(
                            $prepared_words,
                            @words[0 .. (OPT_MAX || 0+@words)-1]);
    }

    say STDERR 0+@matching . " words matched";

    say for @matching; # print out the matching words.

    0;
}

`load_words`

这将从作为命令行参数提供的输入文件中读取所有单词。在这里进行OPT_CONSECUTIVE优化。该$last单词要么被放入匹配单词列表中，要么被放入稍后要匹配的单词列表中。-1 != index($a, $b)决定单词是否是 word的$b子字符串$a。

sub load_words {
    my $matching = shift;
    my @words;
    if (OPT_CONSECUTIVE) {
        my $last;
        while (<>) {
            chomp;
            if (defined $last) {
                push @{-1 != index($_, $last) ? $matching : \@words}, $last;
            }
            $last = $_;
        }
        push @words, $last // ();
    } else {
        @words = map {chomp; $_} <>;
    }
    @words;
}

`prepare_words`

这会“炸毁”输入单词，将它们按照长度排序到每个槽中，这些槽具有更大或相等长度的单词。因此，槽 1 将包含所有单词。如果取消选择此优化，则它是空操作并直接通过输入列表。

sub prepare_words {
    if (OPT_ONDRA) {
       my $ondra_split = sub { # evil: using $_ as implicit argument
           my @split_list;
           for my $i (0 .. length $_) {
               for my $j (1 .. length($_) - ($i || 1)) {
                   push @split_list, substr $_, $i, $j;
               }
           }
           @split_list;
       };
       return +{map {$_ => 1} map &$ondra_split(), @_};
    } elsif (OPT_PRESORT) {
        my @prepared = ([]);
        for my $w (@_) {
            push @{$prepared[$_]}, $w for 1 .. length $w;
        }
        return \@prepared;
    } else {
        return [@_];
    }
}

`test`

这将测试该单词$w是否是任何其他单词中的子字符串。$wbl指向由前一个子创建的数据结构：一个扁平的单词列表，或者按长度排序的单词。然后选择适当的算法。几乎所有的运行时间都花在了这个循环中。使用比使用正则表达式index快得多。

sub test {
    my ($w, $wbl) = @_;
    my $l = length $w;
    if (OPT_PRESORT) {
        for my $try (@{$$wbl[$l + 1]}) {
            return 1 if -1 != index $try, $w;
        }
    } else {
        for my $try (@$wbl) {
            return 1 if $w ne $try and -1 != index $try, $w;
        }
    }
    return 0;
}

`divide`

这只是封装了一种算法，可确保将$items项目公平分配到$parcels存储桶中。它输出一系列项目的边界。

sub divide {
    my ($parcels, $items) = @_;
    say STDERR "dividing $items items into $parcels parcels.";
    my ($min_size, $rest) = (int($items / $parcels), $items % $parcels);
    my @distributions =
        map [
            $_       * $min_size + ($_ < $rest ? $_ : $rest),
            ($_ + 1) * $min_size + ($_ < $rest ? $_ : $rest - 1)
        ], 0 .. $parcels - 1;
    say STDERR "range division: @$_" for @distributions;
    return @distributions;
}

`test_range`

这要求test输入列表中的每个单词，并且是多线程的子。grep选择输入列表中代码（作为第一个参数给出）返回 true 的所有元素。它还定期输出一条状态消息，这样thread 2 at 10%可以更轻松地等待完成。这是一种心理优化；-)。

sub test_range {
    my $wbl = shift;
    if (BLABBER_AT) {
        my $range = @_;
        my $step = int($range / 100 * BLABBER_AT) || 1;
        my $i = 0;
        return
            grep {
                if (0 == ++$i % $step) {
                    printf STDERR "... thread %d at %2d%%\n",
                        threads->tid,
                        $i / $step * BLABBER_AT;
                }
                OPT_ONDRA ? $wbl->{$_} : test($_, $wbl)
            } @_;
    } else {
        return grep {OPT_ONDRA ? $wbl->{$_} : test($_, $wbl)} @_;
    }
}

调用

使用 bash，我调用了类似的脚本

$ time (head -n 1000 /usr/share/dict/words | perl script.pl >/dev/null)

1000我要输入的行数在哪里，dict/words是我使用的单词列表，/dev/null是我要存储输出列表的地方，在这种情况下，将输出扔掉。如果应该读取整个文件，则可以将其作为参数传递，例如

$ perl script.pl input-file >output-file

time只是告诉我们脚本运行了多长时间。使用 2 个慢速处理器和 50000 个字，在我的情况下它只用了两分钟多的时间就执行了，这实际上相当不错。

更新：现在更像是 6-7 秒，使用 Ondra + Presort 优化，没有线程。

进一步优化

更新：通过更好的算法克服。本节不再完全有效。

多线程是可怕的。它分配了相当多的内存，而且速度并不快。考虑到数据量，这并不奇怪。我考虑过使用 a Thread::Queue，但那东西很慢，比如 $@*! 因此是完全不可行的。如果内部循环 intest是用较低级别的语言编码的，则可能会获得一些性能，因为index不必调用内置函数。如果您可以编写 C 代码，请查看该Inline::C模块。如果整个脚本是用低等语言编写的，那么数组访问也会更快。像 Java 这样的语言也会让多线程变得不那么痛苦（而且成本更低）。

regex - 有效地查找作为其他单词子串的单词

3 回答 3

更新

头

main

load_words

prepare_words

test

divide

test_range

调用