Сопоставление с образцом в Perl (просмотр и условие для индекса слова)

Используйте управляющие глаголы 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, используя Lingua::EN::Numbers.

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

• Как в Perl подсчитать количество успешных совпадений на основе условия их абсолютных позиций

Вы можете подсчитать количество точек с запятой в каждой подстроке до соответствующей позиции. Для строки из миллиона слов требуется 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;
}

Пересмотренный ответ

Один относительно простой способ добиться того, что вы хотите, — заменить разделители в исходном тексте, которые встречаются на границе индекса из 5 слов:

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

Теперь вам просто нужно тривиально настроить $pattern для поиска ;the,f вместо ;the;f. Вы можете использовать псевдооператор =()= для возврата счетчика:

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

Оригинальный ответ после перерыва. (Спасибо @choroba за указание на правильную интерпретацию вопроса.)

Символьный ответ

Это использует модификатор регулярного выражения /g в сочетании с pos() для просмотра совпадающих слов. Для иллюстрации я распечатываю все совпадения (не только те, которые находятся на 5-символьных границах), но я печатаю (match) рядом с теми, что на 5-символьных границах. Результат:

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

Во-первых, 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++;
}