我很难思考如何编写一个匹配以下任何一个的正则表达式：
pirates
scallywags
pirates scallywags
scallywags pirates
但这些都不是：
pirates pirates
scallywags scallywags
pirates booty scallywags
booty pirates
当然，我可以列出所有可能的排列作为替代：
(pirates|scallywags|pirates scallywags|scallywags pirates)
但我觉得应该有一个更简单/更有效的方法。
如果你只有两个单词，那么你已经有了最好的解决方案(除了不必要的捕获和丢失的锚点(。
如果你有更多的单词，那么正则表达式引擎不是你的最佳选择。
最有效的基于正则表达式的方法是：
$str =~ /^(?:pirates|scallywags|pirates scallywags|scallywags pirates)z/
缺点是代码重复。这可以避免，同时通过动态构建模式来保持最大的效率。
use Math::Combinatorics qw( );
sub build_re {
my @quoted = map quotemeta, @words;
my @alts;
for my $r (1..$#words) {
my $mc = Math::Combinatorics->new( count => $r, data => @quoted );
while ( my @combo = $mc->next_combination ) {
push @alts, join " ", @combo;
}
}
my $alt = join "|", @alts;
return qr/^(?:$alt)z/;
}
my @words = qw( pirates scallywags );
my $re = build_re(@words, $re);
$str =~ $re
or die "Invalidn";
好吧，两个字不值得，但如果有5个呢？手动创建31个字符串非常容易出错。上面的代码将创建这31个字符串，Perl正则表达式引擎将从中创建一个高效的trie。
但是，使用正则表达式引擎真的是目前最好的选择吗？让我们改为使用计数集。
sub check {
my $words = shift;
my %counts;
++$counts{$_} for split ' ', $_[0];
my $any;
for (@words) {
my $count = delete($counts{$word})
or next;
return 0 if $count > 1;
++$any;
}
return $any && !%counts;
}
my @words = qw( pirates scallywags );
check(@words, $str)
or die "Invalidn";
仍然不够聪明，但可以工作：
^(pirates|scallywags)(?! 1)( (pirates|scallywags))?$
[当我写这篇文章时，我想象在感兴趣的单词之前、之后和中间可能会有其他单词。但这不是你所问的。我会把答案留在这里，以防有人觉得有用。]
使用多个匹配项是最可读的。
/b(?:pirates|scallywags)b/
&& !/b booty b/x &&
&& !/b(pirates|scallywags)b .* b1b/xs
只使用两个are已经影响了可读性。
/b(?:pirates|scallywags)b/
&& !/ b (?: booty | (pirates|scallywags)b .* b1 ) b/xs
它可以用一个来完成。
/
^
(?! .* b (?: booty | (pirates|scallywags)b .* b1 ) b )
.* b(?:pirates|scallywags)b
/xs
如果你想避免扫描字符串两次，你可以使用以下方法：
/
^
(?:(?! b(?:booty|pirates|scallywags)b ).)*
b(?:pirates|scallywags)b
(?:(?! b(?:booty|pirates|scallywags)b ).)*
z
/xs
事实证明，对于熟悉(?:(?!PATTERN).)*习语的人来说，它是相当易读的。
这三个字符串中哪一个最快可能取决于被搜索的字符串的长度、它们包含pirates或scallywags的频率、它们包含booty的频率以及pirates或scallywags的起始位置通常有多近
可能的解决方案，但可能远不是最佳(否定匹配(
use strict;
use warnings;
use feature 'say';
my $re = qr/b(pirates|scallywags)bs+1|bbootyb/;
while(<DATA>) {
chomp;
say if $_ !~ /$re/;
}
__DATA__
pirates
scallywags
pirates scallywags
scallywags pirates
pirates pirates
scallywags scallywags
pirates booty scallywags
booty pirates
输出
pirates
scallywags
pirates scallywags
scallywags pirates