perl中的模式匹配(单词索引的Lookahead和Condition)

时间:2014-10-17 06:12:06

标签: regex perl pattern-matching regex-lookarounds

我有一个长字符串,包含字母词,每个字符由一个字符“;”分隔。整个字符串也以“;”开头和结尾

如果成功匹配的索引可以被5整除,我如何计算模式的出现次数(以“;”开头)。

示例:

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

输出:1

自:

注1:在上述情况下,$ Pattern ;the(?=;f)作为$String中的第1和第10个单词存在;然而;输出结果为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

如果可能的话,我想知道是否有一种方法可以使用单个模式匹配而不使用列表或数组,因为$ String非常长。

4 个答案:

答案 0 :(得分:1)

您可以计算每个子字符串中分号的数量,直到匹配的pos 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;
}

答案 1 :(得分:1)

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

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

然后设置更改,以便如果您的模式不匹配,则第5个单词会被标记,然后使用backtracking control verbs跳过。

以下演示:

#!/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

Live Demo

使用数字1到100的补充示例

对于其他测试,以下使用Lingua::EN::Numbers构造一个包含1到100字格式的所有数字的字符串。

对于模式,它会查找一个单词的数字,下一个数字以字母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种不同的解决方案:

答案 2 :(得分:0)

修订答案

实现所需内容的一种相对简单的方法是替换原始文本中出现在5字索引边界上的分隔符:

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

现在您只需要轻松调整$pattern即可寻找;the,f而不是;the;f。您可以使用=()=伪运算符返回计数:

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

休息后的原始答案。 (感谢@choroba指出对问题的正确解释。)


基于字符的答案

这会将/g正则表达式修饰符与pos()结合使用来查看匹配的单词。为了说明,我打印出所有匹配(不仅仅是5个字符边界上的匹配),但是我在5-char边界旁边打印(match)。输出是:

;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)');
}

答案 3 :(得分:0)

首先,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

可以使用正则表达式的实验性功能来解决你的问题(特别是(?{})块)。在此之前,您应该阅读perldocs中的相应部分。

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++;
}