在perl中进行模式匹配 (Lookahead和Condition on word Index)

问题描述 投票:1回答:4

我有一个很长的字符串,其中包含字母单词,每个单词用一个字符"; "来分隔。整个字符串也以"; "开头和结尾。

如果成功匹配的指数可以除以5,我如何计算一个模式(以"; "开头)的出现次数。

例子:OUTPUT: 1:

$String = ";the;fox;jumped;over;the;dog;the;duck;and;the;frog;"
$Pattern = ";the(?=;f)" 

OUTPUT: 1

自从:

注1:在上面的例子中,$Pattern ;the(?=;f) 作为第1和第10个字存在。$String但是,输出结果将是1,因为只有第二个匹配的索引(10)可以被5整除。

注2:每一个以"; "为界的字都会被计入索引集。

Index of the = 1  -> this does not match since 1 is not divisible by 5
Index of fox = 2
Index of jumped = 3
Index of over = 4
Index of the = 5  -> this does not match since the next word (dog) starts with "d" not "f"    
Index of dog = 6
Index of the = 7  -> this does not match since 7 is not divisible by 5
Index of duck = 8
Index of and = 9
Index of the = 10 -> this does match since 10 is divisible by 5 and the next word (frog) starts with "f"
Index of frog = 11

如果可能的话,我想知道是否有办法在不使用list或数组的情况下,用单个模式匹配来实现这个功能,因为$String非常长。

regex perl pattern-matching regex-lookarounds
4个回答
2
投票

你可以计算每个子串中分号的数量,直到匹配的分号。姿势ition. 对于一个百万字的字符串,需要150秒。

#!/usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my $string = join ';', q(),
             map { qw( the fox jumped over the dog the duck and the frog)[int rand 11] }
             1 .. 1000;
$string .= ';';

my $pattern = qr/;the(?=;f)/;

while ($string =~ /$pattern/g) {
    my $count = substr($string, 0, pos $string) =~ tr/;//;
    say $count if 0 == $count % 5;
}

2
投票

使用Backtracking控制动词一次处理5个字的字符串。

一个解决方案是添加一个边界条件,即该模式前面有4个其他单词。

然后设置一个改变,如果你的模式不匹配,那么第5个单词会被吞噬,然后用以下方法跳过 逆向控制动词.

以下是示范。

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

my $string  = ";the;fox;jumped;over;the;dog;the;duck;and;the;frog;";
my $pattern = qr{;the(?=;f)};

my @matches = $string =~ m{
    (?: ;[^;]* ){4}       # Preceded by 4 words
    (
        $pattern          # Match Pattern
    |
        ;(*SKIP)(*FAIL)   # Or consume 5th word and skip to next part of string.
    )
}xg;

print "Number of Matches = " . @matches . "\n";

输出。

Number of Matches = 1

现场演示

用数字1到100的单词补充例子

为了进行额外的测试,下面使用以下方法构造一个由1到100的word格式的所有数字组成的字符串。Lingua::EN::Numbers.

对于该模式,它寻找一个数字是一个单一的单词,下一个数字是以字母S开头的。

use Lingua::EN::Numbers qw(num2en);

my $string  = ';' . join( ';', map { num2en($_) } ( 1 .. 100 ) ) . ';';
my $pattern = qr{;\w+(?=;s)};

my @matches = $string =~ m{(?:;[^;]*){4}($pattern|;(*SKIP)(*FAIL))}g;

print "@matches\n";

输出的结果。

;five ;fifteen ;sixty ;seventy

更多技术的参考

下面这个上个月的问题是一个非常类似的问题。 然而,除了这里演示的解决方案外,我还提供了5种不同的解决方案。


1
投票

订正答案

有一个比较简单的方法可以达到你想要的效果,那就是替换原文中出现在5个字索引边界上的定界符。

$text =~ s/;/state $idx++ % 5 ? ',' : ';'/eg;

现在你只需要微不足道地调整你的 $pattern 寻找 ;the,f 而不是 ;the;f. 您可以使用 =()= 伪运算符来返回计数。

my $count =()= $text =~ /;the(?=,f)/g;

中断后的原答案。(感谢@choroba指出本题的正确解释。)


基于字符的答案

这使用的是 /g 与regex修饰符结合使用 pos() 来看匹配的单词。为了说明问题,我打印出 匹配(不仅仅是那些在5个字符边界上的匹配),但我打印了 (match) 旁边的5-char边界上的那些。输出是:

;the;fox;jumped;over;the;dog;the;duck;and;the;frog
^....^....^....^....^....^....^....^....^....^....
`the' @0 (match)
`the' @41

代码是:

#!/usr/bin/env perl

use 5.010;

my $text = ';the;fox;jumped;over;the;dog;the;duck;and;the;frog';

say $text;
say '^....^....' x 5;

my $pat = qr/;(the)(?=;f)/;
#$pat = qr/;([^;]+)/;
while ($text =~ /$pat/g) {
    my $pos = pos($text) - length($1) - 1;
    say "`$1' \@$pos". ($pos % 5 ? '' : ' (match)');
}

1
投票

首先是: pos 也可以作为左手边的表达方式。你可以利用 \G 断言结合 index (因为你关心的是速度)。我扩展了你的例子,以表明它只 "匹配 "5的除数(你的例子也允许不被5整除的指数是 1 也是一种解决方案)。) 由于你只想要匹配的数量,我只用了一个 $count 变量,并进行递增。如果你想要更多的东西,可以使用普通的 if {} 子句,并在该块中做一些事情。

my $string = ";the;fox;jumped;over;the;dog;the;duck;and;the;frog;or;the;fish";
my $pattern = qr/;the(?=;f)/;
my ($index,$count, $position) = (0,0,0);

while(0 <= ($position = index $string, ';',$position)){
  pos $string = $position++;              #add one to $position, to terminate the loop
  ++$count if (!(++$index % 5) and $string =~/\G$pattern/);
}

say $count; # says 1, not 2

可以 使用regexes的实验性功能来解决你的问题(尤其是使用 (?{}) 块)。) 在你这样做之前,你真的应该先读一读本书中相应的章节。蟛蜞菊.

my ($index, $count) = (0,0);

while ($string =~ /;               # the `;'
           (?(?{not ++$index % 5}) # if with a code condition
             the(?=;f)             # almost your pattern, but we'll have to count 
           |(*FAIL))               # else fail
          /gx) {
  $count++;
}
© www.soinside.com 2019 - 2024. All rights reserved.