正则表达式以任意顺序匹配另一个字符串中的字符

Question

考虑以下字符串wizard。我想在任何情况下以任何顺序查找它是否在另一个字符串中。

我尝试了以下

while(<>){if($_=~/(?:([wizard])(?!.*\1)){6}/i){print"0"}else{print"1"}}

对于输入

Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

打印的是111111，但肯定是111011。

所以，我尝试了这个（对于相同的输入）

while(<>){if($_=~/(?=[wizard]{6})(?!.*(.).*\1).*/i){print"0"}else{print"1"}}

它再次打印了111111。 在输入数字 4 中，我们可以创建 WaDriaz，但只需要一个 a。无论如何，我们可以通过重新排列拼写wizard，无论如何。为什么它不起作用？

我的代码有什么问题？

Answer 1

这是一个纯正则表达式：为每个字符执行 positive lookahead

use warnings;
use strict;
use feature 'say';
use List::Util qw(uniq);  # before v. 1.45 in List::MoreUtils    

my $string = shift // q(wizard);

my $patt = join '', map { qq{(?=.*\Q$_\E)} } uniq split //, $string; 
# say $patt;  
#--> (?=.*w)(?=.*i)(?=.*z)(?=.*a)(?=.*r)(?=.*d)   (for wizard)

while (<DATA>) {
    say "Found '$string' in: $_" if /^$patt/is;
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

全部在一个正则表达式中，具有锚定的前瞻性并且没有开销，这应该非常快。

\Q...\E 用于防止搜索字符串包含正则表达式敏感字符。

请注意，此代码会查找具有重复字符的单词（latte、rare、letter）以匹配没有重复字符的单词（later）。 cmets 明确了这确实是想要的行为：重复字符只需要在目标中找到一次（letter 匹配 later 等）。

Answer 2

以下应该是相当快的（特别是如果你内联潜艇）：

use feature qw( fc say );

sub make_key {
   my %counts;
   ++$counts{$_} for split //, fc($_[0]) =~ s/\PL//rg;
   return \%counts;
}

sub search {
   my ($substr, $str) = @_;
   $str = make_key($str);
   no warnings qw( uninitialized );
   return !( grep { $str->{$_} < $substr->{$_} } keys(%$substr) );
}

my $substr = make_key("wizard");
while (<>) {
   chomp;
   say search($substr, $_) ? 0 : 1;
}

与几乎所有以前的解决方案不同，这个解决方案不认为latte 在late 中。

---

以下是基于正则表达式的解决方案（有一些准备）。这也应该很快（特别是如果你内联潜艇）。

use feature qw( fc say );

sub make_re {
   my $pat = join ".*?", map quotemeta, sort split //, fc($_[0]) =~ s/\PL//rg;
   return qr/$pat/s;
}

sub search {
   my ($substr, $str) = @_;
   return ( join "", sort split //, $str ) =~ $substr;
}

my $substr = make_re("wizard");   # qr/a.*?d.*?i.*?r.*?w.*?z/is
while (<>) {
   chomp;
   say search($substr, $_) ? 0 : 1;
}

---

最后，一个纯粹的基于正则表达式的解决方案。

use feature qw( fc say );

sub make_re {
   my %counts;
   ++$counts{$_} for split //, fc($_[0]) =~ s/\PL//rg;
   my $pat =
      join "",   
         map { "(?=".( ( ".*?" . quotemeta($_) ) x $counts{$_} ).")" }
            #sort
               keys(%counts);
   return qr/^$pat/s;
}

my $re = make_re("wizard");  # qr/^(?=.*?a)(?=.*?d)(?=.*?i)(?=.*?r)(?=.*?w)(?=.*?z)/is
while (<>) {
   say /$re/ ? 0 : 1;
}

---

与几乎所有以前的解决方案不同，我没有人认为latte 在late 中。

Answer 3

我发现输入和模式的规范化是一种更通用和易于理解的方法：

#!/usr/bin/env perl

use strict;
use warnings;

sub canonchars {
    my %c;
    $c{$_} = undef for map lc, grep /\S/, split //, $_[0];
    sort keys %c;
}

sub pattern {
    map "$_.*", canonchars($_[0]);
}

my %canonical;

while (my $line = <DATA>) {
    last unless $line =~ /\S/;
    push $canonical{join '', canonchars($line)}->@*, $line;
}

my $pat = qr/@{[join '', pattern('wizard')]}/;

for my $k (keys %canonical) {
    if ($k =~ $pat) {
        print for $canonical{$k}->@*;
    }
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

输出：

C:\Temp> perl t.pl
Wayne Drimaz

您试图将很多逻辑融入正则表达式模式，而您发现和修复的每一个边缘情况都会使其更加复杂和脆弱。

Answer 4

对每个角色使用积极的前瞻只是一件简单的事情。

my @stars = (
  'Garry Kasparov',
  'Bobby Fischer',
  'Vladimir Kramnik',
  'Wayne Drimaz',
  'Lionel Messi',
  'La Signora'
);

say /^(?=.*w)(?=.*i)(?=.*z)(?=.*a)(?=.*r)(?=.*d)/i ? 0 : 1 for @stars;

这会输出111011。

Answer 5

不需要正则表达式...它们只会使事情复杂化，尤其是如果您不是在寻找提前知道的字符串时。在规范化他们的情况后，依次寻找每个字符。

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

sub contains_chars {
    my ($needle, $haystack) = @_;
    $haystack = lc $haystack;
    my %positions;
    for my $char (split //, lc $needle) {
        my $p = index $haystack, $char, $positions{$char}//0;
        return 1 if $p < 0;
        $positions{$char} = $p + 1;
    }
    return 0;
}

while (<DATA>) {
    print contains_chars("wIzArD", $_);
}
print "\n";

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

Answer 6

这是一种可能发生乱序匹配的黑魔法。
源字符串中的每个字符只被访问一次。
无需为每个字母从头开始递归字符串。

use strict;
use warnings;

while (my $line = <DATA>) {
   if ( $line =~ /
     (?:
       .*?
       (?:
           (?(1)(?!))(w)
         | (?(2)(?!))(i)
         | (?(3)(?!))(z)
         | (?(4)(?!))(a)
         | (?(5)(?!))(r)
         | (?(6)(?!))(d)
       )
     ){6}/ix ) { print $line, "\n" }
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

韦恩·德里马兹

捕获可以以两种状态存在，已定义或未定义。
这种黑色艺术的本质是使用捕获状态作为标志
以确保所有项目都在乱序状态下匹配。

上面也可以这样写，结果相同。

use strict;
use warnings;

while (my $line = <DATA>) {
   if ( $line =~ /
     (?im)
     ^ 
     (?>
        .*? 
        (?:
           w ( )       # (1)
         | i ( )       # (2)
         | z ( )       # (3)
         | a ( )       # (4)
         | r ( )       # (5)
         | d ( )       # (6)
        )
     )+
     (?= \1 \2 \3 \4 \5 \6 )
   /x ) { print $line, "\n" }
}

__DATA__
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Lionel Messi
La Signora

Answer 7

只需添加我在 cmets 中提到的 /w/ && /i/ && /z/ ... 解决方案的简单变体。如果您希望此解决方案匹配许多不同的字符串，而不是将正则表达式与&& 一起排列，您可以简单地循环字符。一个有用的工具是使用&&= 运算符来模拟一长串条件的行为。如果我们发现不匹配，这也将允许我们将匹配短路，从而为我们带来速度优势。

例如：

/a/ && /b/ && /c/

相当于

my $match = 1;
for my $w (qw(a b c)) {
    $match &&= (/$w/);    # $match = ($match && /$w/)
}

要记住字母的数量，即是否应将latte 视为late 的子字符串，您可以简单地使用替换运算符s/// 而不是匹配运算符m//。我添加了多字母条件，并添加了两个测试用例进行演示。

我喜欢这个解决方案，因为它很简单，但并不是说它是最好的。

use strict;
use warnings;

my $word = "wizzard";

while (<DATA>) {
    print search($_, $word), " $_";
}

sub search {
    my ($str, $substr) = @_;
    my $match = 1;                        # assume true
    for my $w (split //, $substr) {       # for each char in substr...
        $match &&= ($str =~ s/\Q$w//i);   # ...remove character
        return 0 if not $match;           # ...return false if no match found
    }
    return 1 if $match;
}

__DATA__
wizard
wizzard
Garry Kasparov
Bobby Fischer
Vladimir Kramnik
Wayne Drimaz
Wayne Drimazz
Lionel Messi
La Signora

输出：

0 wizard
1 wizzard
0 Garry Kasparov
0 Bobby Fischer
0 Vladimir Kramnik
0 Wayne Drimaz
1 Wayne Drimazz
0 Lionel Messi
0 La Signora

如果您不关心多字母匹配，只需将s/// 替换为m//。