考虑以下字符串 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
。为什么它不起作用?
我的代码有什么问题?
答案 0 :(得分:4)
这是一个纯正则表达式:为每个字符做一个 https://github.com/d3/d3/issues/3501
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
全部都在一个正则表达式中,具有锚定前瞻且没有开销,这应该非常快。
如果搜索字符串包含正则表达式敏感字符,则存在 positive lookahead。
请注意,此代码查找具有重复字符 (latte
, rare
, letter
) 的单词以适合没有重复字符 (later
) 的单词。在评论中澄清说这确实是想要的行为:重复的字符只需要在目标中找到一次(letter
匹配 later
等)。
答案 1 :(得分:4)
以下应该很快(特别是如果您内联 subs):
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
中。
以下是基于正则表达式的解决方案(有一些准备)。这也应该非常快(特别是如果您内联 subs)。
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
中。
答案 2 :(得分:3)
这只是对每个字符使用正向预测的简单问题。
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
。
答案 3 :(得分: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
您正试图将很多逻辑融入正则表达式模式,而您发现并修复的每一个边缘情况都会使其变得更加复杂和脆弱。
答案 4 :(得分:3)
不需要正则表达式...它们只会使事情复杂化,特别是如果您不寻找提前知道的字符串。将它们的情况标准化后,只需依次查找每个字符即可。
#!/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
答案 5 :(得分:3)
这是一种可能发生乱序匹配的黑魔法。
源字符串中的每个字符只访问一次。
无需为每个字母从头开始递归字符串。
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
答案 6 :(得分:1)
只需添加我在评论中提到的 /w/ && /i/ && /z/ ...
解决方案的简单变体。如果您希望此解决方案匹配许多不同的字符串,而不是用 &&
将正则表达式排列在一起,您可以简单地遍历字符。一个有用的工具是使用 &&=
运算符来模拟一长串条件的行为。如果我们发现不匹配,这也将允许我们短路匹配,从而为我们带来速度优势。
例如:
/a/ && /b/ && /c/
相当于
my $match = 1;
for my $w (qw(a b c)) {
$match &&= (/$w/); # $match = ($match && /$w/)
}
要记住字母的数量,即 latte
是否应该被视为 late
的子字符串,您可以简单地使用替换运算符 s///
而不是匹配运算符 {{1 }}。我添加了多字母条件,并添加了两个测试用例来演示。
我喜欢这个解决方案,因为它很简单,但也不能说它是最好的。
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///
。