Perl абзац н-грамм

Question

Допустим, у меня есть текстовое предложение:

$body = 'the quick brown fox jumps over the lazy dog';

, и я хочу перевести это предложение в хэш «ключевых слов», но я хочу разрешить ключевые слова из нескольких слов;У меня есть следующее, чтобы получить ключевые слова из одного слова:

$words{$_}++ for $body =~ m/(\w+)/g;

После этого у меня есть хэш, который выглядит следующим образом:

'the' => 2,
'quick' => 1,
'brown' => 1,
'fox' => 1,
'jumps' => 1,
'over' => 1,
'lazy' => 1,
'dog' => 1

Следующий шаг, так что яможет получить ключевые слова из 2 слов, это следующее:

$words{$_}++ for $body =~ m/(\w+ \w+)/g;

Но это получает только каждую "другую" пару;выглядит так:

'the quick' => 1,
'brown fox' => 1,
'jumps over' => 1,
'the lazy' => 1

Мне также нужно смещение в одно слово:

'quick brown' => 1,
'fox jumps' => 1,
'over the' => 1

Есть ли более простой способ сделать это, чем следующий?

my $orig_body = $body;
# single word keywords
$words{$_}++ for $body =~ m/(\w+)/g;
# double word keywords
$words{$_}++ for $body =~ m/(\w+ \w+)/g;
$body =~ s/^(\w+)//;
$words{$_}++ for $body =~ m/(\w+ \w+)/g;
$body = $orig_body;
# triple word keywords
$words{$_}++ for $body =~ m/(\w+ \w+ \w+)/g;
$body =~ s/^(\w+)//;
$words{$_}++ for $body =~ m/(\w+ \w+ \w+)/g;
$body = $orig_body;
$body =~ s/^(\w+ \w+)//;
$words{$_}++ for $body =~ m/(\w+ \w+ \w+)/g;

Answer 1

Хотя описанная задача может быть интересна для написания кода вручную, не лучше ли использовать существующий модуль CPAN, который обрабатывает n-граммы?Похоже, Text::Ngrams (в отличие от Text::Ngram) может обрабатывать n-граммовый анализ на основе слов.

Answer 2

Вы можете сделать что-то немного прикольное с lookaheads :

Если я сделаю:

$words{$_}++ for $body =~ m/(?=(\w+ \w+))\w+/g;

Это выражение говорит, что нужно смотреть вперед на два слова (и захватих), но потребляют 1.

Я получаю:

%words: {
          'brown fox' => 1,
          'fox jumps' => 1,
          'jumps over' => 1,
          'lazy dog' => 1,
          'over the' => 1,
          'quick brown' => 1,
          'the lazy' => 1,
          'the quick' => 1
        }

Кажется, я могу обобщить это, введя переменную для количества:

my $n    = 4;
$words{$_}++ for $body =~ m/(?=(\w+(?: \w+){$n}))\w+/g;

Answer 3

Я бы использовал упреждения , чтобы собрать все, кроме первого слова. Таким образом, позиция продвигается правильно автоматически:

my $body = 'the quick brown fox jumps over the lazy dog';

my %words;

++$words{$1}         while $body =~ m/(\w+)/g;
++$words{"$1 $2"}    while $body =~ m/(\w+) \s+ (?= (\w+) )/gx;
++$words{"$1 $2 $3"} while $body =~ m/(\w+) \s+ (?= (\w+) \s+ (\w+) )/gx;

Вы могли бы немного упростить это, если хотите использовать один пробел вместо \s+ (не забудьте удалить модификатор /x, если вы это сделаете), так как вы можете собрать любое количество слов в $2 вместо использования одной группы в слове.

Answer 4

Есть ли какая-то особая причина для этого, используя одни регулярные выражения? Для меня очевидным подходом было бы split текст в массив, а затем использовать пару вложенных циклов, чтобы извлечь из него количество. Что-то вроде:

#!/usr/bin/env perl

use strict;
use warnings;

my $text = 'the quick brown fox jumps over the lazy dog';
my $max_words = 3;

my @words = split / /, $text;
my %counts;

for my $pos (0 .. $#words) {
  for my $phrase_len (0 .. ($pos >= $max_words ? $max_words - 1 : $pos)) {
    my $phrase = join ' ', @words[($pos - $phrase_len) .. $pos];
    $counts{$phrase}++;
  }
} 

use Data::Dumper;
print Dumper(\%counts);

Выход:

$VAR1 = {
          'over the lazy' => 1,
          'the' => 2,
          'over' => 1,
          'brown fox jumps' => 1,
          'brown fox' => 1,
          'the lazy dog' => 1,
          'jumps over' => 1,
          'the lazy' => 1,
          'the quick brown' => 1,
          'fox jumps' => 1,
          'over the' => 1,
          'brown' => 1,
          'fox jumps over' => 1,
          'quick brown' => 1,
          'jumps' => 1,
          'lazy' => 1,
          'jumps over the' => 1,
          'lazy dog' => 1,
          'dog' => 1,
          'quick brown fox' => 1,
          'fox' => 1,
          'the quick' => 1,
          'quick' => 1
        };

Редактировать: Исправлен цикл $phrase_len для предотвращения использования отрицательных индексов, которые приводили к неверным результатам, согласно комментарию cjm.

Answer 5

Используйте оператор pos

pos SCALAR

Возвращает смещение, где последний m//g поиск остановился для рассматриваемой переменной($_ используется, когда переменная не указана).

и специальный массив @-

@ LAST_MATCH_START

@ -

$-[0] - смещение начала последнего успешного матча.$-[n] - это смещение начала подстроки, совпадающее с n -ым подшаблоном или undef, если подшаблон не совпадает.

Например, программаниже захватывает второе слово каждой пары в своем собственном захвате и перематывает позицию матча так, чтобы вторым словом было первое слово следующей пары:

#! /usr/bin/perl

use warnings;
use strict;

my $body = 'the quick brown fox jumps over the lazy dog';

my %words;
while ($body =~ /(\w+ (\w+))/g) {
  ++$words{$1};
  pos($body) = $-[2];
}

for (sort { index($body,$a) <=> index($body,$b) } keys %words) {
  print "'$_' => $words{$_}\n";
}

Вывод:

'the quick' => 1
'quick brown' => 1
'brown fox' => 1
'fox jumps' => 1
'jumps over' => 1
'over the' => 1
'the lazy' => 1
'lazy dog' => 1