Come posso contare le sottostringhe sovrapposte in Perl?

Question

Ho bisogno di implementare un programma per contare l'occorrenza di una sottostringa in una stringa in perl. l'ho implementato come segue

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

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

print "$count\n"; 

ora questo è quello che vorrei fare normalmente. tuttavia, nell'implementazione precedente voglio contare l'occorrenza di 'aa' in 'aaa'. qui ottengo risposta come 1 che sembra ragionevole, ma ho bisogno di considerare anche i casi che si sovrappongono. quindi il caso sopra dovrebbe dare una risposta come 2 poiché ci sono due "aa" se consideriamo la sovrapposizione.

qualcuno può suggerire come implementare tale funzione ??

Answer 1

Vedere ysth's answer ... Non sono riuscito a capire che il modello potrebbe essere costituito esclusivamente da un'asserzione di larghezza zero e che funziona ancora per questo scopo.

È possibile utilizzare positive lookahead come suggerito da altri, e scrivere la funzione come:

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

È inoltre possibile utilizzare pos per regolare in cui la ricerca successiva raccoglie da:

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

uscita:

 
C:\Temp> t 
2 

Answer 2

È possibile utilizzare un lookahead assertion nell'espressione regolare:

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

    return scalar @matches; 
} 

Sospetto che il suggerimento di Sinan sarà più veloce.

Answer 3

puoi provare questo, non più regex del necessario.

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

uscita

$ ./perl.pl 
Total count: 4 

Answer 4

Ognuno è sempre piuttosto complicata nelle loro risposte (d'oh! Daotoad dovrebbe aver fatto il suo commento una risposta!), Forse perché hanno paura dell'operatore goatse. Non l'ho chiamato, è solo quello che la gente chiama. Usa il trucco che il risultato di un assegnamento di lista è il numero di elementi nella lista di destra.

Il linguaggio Perl per contare gli incontri è quindi:

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

La parte goatse è il =() =, che è un elenco vuoto nel mezzo di due assegnazioni. La parte sinistra della capra prende il conteggio dal lato destro della capra. Nota che hai bisogno di un'acquisizione nel modello perché è l'elenco che l'operatore di corrispondenza restituirà nel contesto dell'elenco.

Ora, il trucco successivo nel tuo caso è che vuoi davvero un lookbehind positivo (o magari guardare avanti). I lookarounds non consumano personaggi, quindi non c'è bisogno di tenere traccia della posizione:

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

tuo aaa è solo un esempio. Se hai un pattern a larghezza variabile, devi usare un lookahead. I guardiani del Perl devono essere a larghezza fissa.

Answer 5

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

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

print "$count\n"; 

alcuni punti:

//g in contesto lista partite come numero di volte possibile.

\Q...\E viene utilizzato per eseguire l'escape automatico di qualsiasi metacarattere, in modo da eseguire un conteggio della sottostringa, non un conteggio parziale.

L'utilizzo di una testa di controllo (?= ...) fa sì che ogni corrispondenza non "consumi" alcuna stringa, consentendo di tentare la corrispondenza successiva nel carattere successivo.

Questo utilizza la stessa funzione in cui un'assegnazione di lista (in questo caso, a una lista vuota) in contesto scalare restituisce il conteggio degli elementi a destra dell'assegnazione lista come goatse/flying-lentil/spread-eagle/qualunque operatore, ma usa scalare() invece di un assegnamento scalare per fornire il contesto scalare.

$_[0] non viene utilizzato direttamente, ma è copiato in un lessico; un uso ingenuo di $_[0] al posto di $string farebbe sì che //g iniziasse a parte attraverso la stringa invece che all'inizio se la stringa passata aveva uno pos() memorizzato.

Aggiornamento: s /// g è più veloce, anche se non così rapidamente come utilizzando l'indice:

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

Answer 6

Se la velocità è un problema, l'approccio suggerito da index ghostdog74 (con un miglioramento del CJM) è probabile che sia considerevolmente più veloce delle soluzioni regex.

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