Как подсчитать перекрывающиеся подстроки в Perl?

Question

Мне нужно реализовать программу для подсчета вхождения подстроки в строку в Perl. я реализовал это следующим образом

sub countnmstr
{
  $count =0;
  $count++ while $_[0] =~ /$_[1]/g;
  return $count;
}

$count = countnmstr("aaa","aa");

print "$count\n";

Теперь это то, что я обычно делаю. однако в приведенной выше реализации я хочу посчитать вхождение 'aa' в 'aaa'. здесь я получаю ответ как 1, который кажется разумным, но мне нужно рассмотреть также и перекрывающиеся случаи. следовательно, вышеупомянутый случай должен дать ответ как 2, так как есть два «аа», если мы рассматриваем перекрытие.

Может кто-нибудь подсказать, как реализовать такую ​​функцию ??

Answer 1

Каждый становится довольно сложным в своих ответах (да! Даотоад должен был сделать свой комментарий ответом!), Возможно, потому, что они боятся оператора козла. Я не назвал это, просто люди так называют. Он использует хитрость, заключающуюся в том, что результатом назначения списка является количество элементов в правом списке.

Тогда идиома Perl для подсчета совпадений:

 my $count = () = $_[0] =~ /($pattern)/g;

Часть козла - это = () =, который является пустым списком в середине двух назначений. Левая часть козла получает счет с правой стороны козла. Обратите внимание, что вам нужен захват в шаблоне, потому что это список, который оператор совпадения вернет в контексте списка.

Теперь, следующий трюк в вашем случае заключается в том, что вам действительно нужен позитивный взгляд назад (или, может быть, взгляд вперед). Внешние символы не потребляют символы, поэтому вам не нужно отслеживать положение:

 my $count = () = 'aaa' =~ /((?<=a)a)/g;

Ваш aaa является лишь примером. Если у вас есть шаблон переменной ширины, вы должны использовать упреждающий взгляд. Взгляды в Perl должны быть фиксированной ширины.

Answer 2

sub countnmstr
{
    my ($string, $substr) = @_;
    return scalar( () = $string =~ /(?=\Q$substr\E)/g );
}

$count = countnmstr("aaa","aa");

print "$count\n";

Несколько баллов:

//g в контексте списка совпадает столько раз, сколько возможно.

\Q...\E используется для автоматического экранирования любых метасимволов, поэтому вы выполняете подсчет подстрок, а не подсчет подшаблонов.

Использование заглядывания (?= ... ) приводит к тому, что каждое совпадение не "потребляет" ни одной строки, что позволяет выполнить следующее сопоставление на следующем символе.

При этом используется та же функция, при которой назначение списка (в данном случае пустому списку) в скалярном контексте возвращает количество элементов справа от назначения списка как goatse / flying-lentil / spread-eagle / what оператор, но использует scalar () вместо скалярного присваивания для предоставления скалярного контекста.

$_[0] не используется напрямую, а вместо этого копируется в лексическое; наивное использование $_[0] вместо $string приведет к тому, что //g будет начинаться частично через строку, а не с начала, если переданная строка имела сохраненный pos().

Обновление: s /// g быстрее, но не так быстро, как при использовании индекса:

sub countnmstr
{
    my ($string, $substr) = @_;
    return scalar( $string =~ s/(?=\Q$substr\E)//g );
}

Answer 3

См. ответ ysth ... Я не смог понять, что шаблон может состоять исключительно из утверждения нулевой ширины и все еще работать для этой цели.

Вы можете использовать положительный прогноз , как это предлагают другие, и написать функцию как:

sub countnmstr {
    my ($haystack, $needle) = @_;
    my ($first, $rest) = $needle =~ /^(.)(.*)$/;
    return scalar (() = $haystack =~ /(\Q$first\E(?=\Q$rest\E))/g);
}

Вы также можете использовать pos, чтобы указать, откуда начинается следующий поиск:

#!/usr/bin/perl

use strict; use warnings;

sub countnmstr {
    my ($haystack, $needle) = @_;
    my $adj = length($needle) - 1;
    die "Search string cannot be empty!" if $adj < 0;

    my $count = 0;
    while ( $haystack =~ /\Q$needle/g ) {
        pos $haystack -= $adj;
        $count += 1;
    }
    return $count;
}

print countnmstr("aaa","aa"), "\n";

Выход:

C:\Temp> t
2

Answer 4

Если скорость является проблемой, подход index, предложенный ghostdog74 (с улучшением cjm), вероятно, будет значительно быстрее, чем решения регулярных выражений.

use strict;
use warnings;

sub countnmstr_regex {
    my ($haystack, $needle) = @_;
    return scalar( () = $haystack =~ /(?=\Q$needle\E)/g );
}

sub countnmstr_index {
    my ($haystack, $needle) = @_;
    my $i = 0;
    my $tally = 0;
    while (1){
        $i = index($haystack, $needle, $i);
        last if $i == -1;
        $tally ++;
        $i ++;
    }
    return $tally;
}

use Benchmark qw(cmpthese);

my $size = 1;
my $h = 'aaa aaaaaa' x $size;
my $n = 'aa';

cmpthese( -2, {
    countnmstr_regex => sub { countnmstr_regex($h, $n) },
    countnmstr_index => sub { countnmstr_index($h, $n) },
} );

__END__

# Benchmarks run on Windows.
# Result using a small haystack ($size = 1).
                     Rate countnmstr_regex countnmstr_index
countnmstr_regex  93701/s               --             -66%
countnmstr_index 271893/s             190%               --

# Result using a large haystack ($size = 100).
                   Rate countnmstr_regex countnmstr_index
countnmstr_regex  929/s               --             -81%
countnmstr_index 4960/s             434%               --

Answer 5

вы можете попробовать это, не больше регулярных выражений, чем необходимо.

$haystack="aaaaabbbcc";
$needle = "aa";
while ( 1 ){
    $ind = index($haystack,$needle);
    if ( $ind == -1 ) {last};
    $haystack = substr($haystack,$ind+1);
    $count++;
}
print "Total count: $count\n";

выход

$ ./perl.pl
Total count: 4

Answer 6

В регулярном выражении можно использовать прогнозное утверждение :

sub countnmstr {
    my @matches = $_[0] =~ /(?=($_[1]))/g;

    return scalar @matches;
}

Я подозреваю, что предложение Синан будет быстрее.