¿Cómo puedo contar las subcadenas superpuestas en Perl?

Question

necesito implementar un programa para contar la ocurrencia de una subcadena en una cadena en perl. Lo he implementado de la siguiente manera

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

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

print "$count\n"; 

ahora esto es lo que normalmente haría. sin embargo, en la implementación anterior quiero contar la ocurrencia de 'aa' en 'aaa'. Aquí recibo una respuesta como 1, que parece razonable, pero también tengo que considerar los casos superpuestos. por lo tanto, el caso anterior debería dar una respuesta como 2 ya que hay dos 'aa si consideramos la superposición.

¿alguien puede sugerir cómo implementar tal función?

Answer 1

Ver ysth's answer ... No me di cuenta de que el patrón podría consistir únicamente en una aserción de ancho cero y seguir trabajando para este fin.

Puede utilizar positive lookahead según lo sugerido por otros, y escribir la función como:

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

También puede utilizar pos para ajustar en la siguiente búsqueda recoge desde:

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

de salida:

 
C:\Temp> t 
2 

Answer 2

Puede utilizar lookahead assertion en la expresión regular:

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

    return scalar @matches; 
} 

sospecho sugerencia de Sinan será más rápido sin embargo.

Answer 3

puede probar esto, no más regex de lo necesario.

$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"; 

salida

$ ./perl.pl 
Total count: 4 

Answer 4

Todo el mundo está volviendo muy complicada en sus respuestas (d'oh! Daotoad debería haber hecho su comentario una respuesta!), Tal vez porque tienen miedo de que el operador goatse. No lo llamé, así es como lo llaman las personas. Utiliza el truco de que el resultado de una asignación de lista es el número de elementos en la lista de la derecha.

El lenguaje Perl para el recuento de coincidencias es entonces:

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

La parte goatse es la =() =, que es una lista vacía en medio de dos asignaciones. La parte izquierda del cabras recibe el conteo desde el lado derecho del macho cabrío. Tenga en cuenta que necesita una captura en el patrón porque esa es la lista que devolverá el operador de coincidencia en el contexto de la lista.

Ahora, el siguiente truco en su caso es que realmente quiere un aspecto positivo detrás (o mirar hacia adelante tal vez). Los lookarounds no consumen caracteres, por lo que no es necesario hacer un seguimiento de la posición:

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

Su aaa es sólo un ejemplo. Si tiene un patrón de ancho variable, debe usar un lookahead. Lookbehinds en Perl tiene que ser de ancho fijo.

Answer 5

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

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

print "$count\n"; 

Unos pocos puntos:

//g en contexto lista coincide tantas veces como sea posible.

\Q...\E se utiliza para escanear automáticamente cualquier metacaracteres, por lo que está haciendo un recuento de subcadenas, no un recuento de subpatrones.

El uso de un vistazo (?= ...) hace que cada coincidencia no "consuma" ninguna de las cuerdas, lo que permite intentar la siguiente coincidencia en el siguiente caracter.

Utiliza la misma función donde una asignación de lista (en este caso, a una lista vacía) en contexto escalar devuelve el recuento de elementos a la derecha de la asignación de lista como el cabras/flying-lentil/spread-eagle/sea ​​cual sea el operador, pero utiliza escalar() en lugar de una asignación escalar para proporcionar el contexto escalar.

$_[0] no se usa directamente, sino que se copia a un léxico; un uso ingenuo de $_[0] en lugar de $string provocaría que el //g comenzara a medio camino a través del hilo en lugar de al principio si el hilo pasado tenía un pos() almacenado.

Actualización: s /// g es más rápido, aunque no tan rápido como el uso de índice:

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

Answer 6

Si la velocidad es un problema, el enfoque sugerido por index ghostdog74 (con una mejora del CJM) es probable que sea considerablemente más rápido que las soluciones de expresiones regulares.

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%    --