Perl nicht übereinstimmende Zeichenfolge suchen

Question

Wie finden Sie, ob eine Zeichenfolge mit einer oder zwei Übereinstimmungen in einer anderen Zeichenfolge vorhanden ist?

my $find = "MATCH"; 
my $search = "stringisMATTHhere"; 

# $search has one mismatch: MATTH 
# for exact match, this one seems working 
if ($search =~ /$find/){ 
     print "String found"; 
    } 
else { 
     print "String not found"; 
    } 

Wie kann ich lösen dieses Problem mit einem Mismatch: MSTCH, AATCH, MACCH usw. und zwei Fehlpaarungen: ATTCH, MGGCH, etc

Answer 1

So möchten Sie tun

/ 
    ..TCH | .A.CH | .AT.H | .ATC. | 
    M..CH | M.T.H | M.TC. | 
    MA..H | MA.C. | 
    MAT.. 
/x 

oder

/ 
    \w\wTCH | \wA\wCH | \wAT\wH | \wATC\w | 
    M\w\wCH | M\wT\wH | M\wTC\w | 
    MA\w\wH | MA\wC\w | 
    MAT\w\w 
/x 

Einfach genug:

my @subpats; 
for my $i (0..length($find)-1) { 
    for my $j ($i+1..length($find)-1) { 
     my $subpat = join('', 
     substr($find, 0, $i), 
     '.', # or '\\w' 
     substr($find, $i+1, $j-$i-1), 
     '.', # or '\\w' 
     substr($find, $j+1), 
    ); 
     push @subpats, $subpat; 
    } 
} 

my $pat = join('|', @subpats); 

$search =~ /$pat/ 

Perl 5.10+ Trie-basierte Abwechslungen sollten die gemeinsamen führenden Präfixe in etwas effizienter optimieren. Spart uns die Mühe, (?:.…|M…) zu erzeugen.

Answer 2

Soweit ich weiß, gibt es nur eine bequeme Lösung mit eine spezielle REGEX Engine: https://metacpan.org/pod/re::engine::TRE.

Hier ist die Lösung für Ihr Beispiel:

#!/usr/bin/perl 

use strict; 
use warnings; 

use re::engine::TRE max_cost => 2; 

my $find = "MATCH"; 
my $search = "stringisMATTHhere"; 

if ($search =~ /\($find\)/) { 
    print $1,"\n"; 
} 

Diese Ausgänge:

$ perl fuzzy_re.pl 
MATTH 

Answer 3

Ich habe wieder Interesse an dieser so dachte ich, dass ich etwas mit ein wenig mehr
Variabilität würde versuchen, auf kontrollierte Weise.

Merkmale:
- Kann einen Min/Max-Anpassungsbereich für einzelne Suchvorgänge festlegen.
- Kann ein Flag setzen, um Platz 0x20 oder weniger in der Anzahl der Übereinstimmungen auszuschließen/einzuschließen.
- Automatisch Meta-Zeichen in Finds entkommen.

Das ist es.
Viel Glück !!

---

Regex:

(?s) 
(?{ $cnt = 0; $lcnt = 0 }) 
(?: 
     (?> 
      (??{ $aryinput[$lcnt++] }) 
     | (?&getexpr) 
    ) 
){$len} 
(??{ $cnt >= $mincnt && $cnt <= $maxcnt ? '' : '(?!)' }) 

(?(DEFINE) 
     (?<getexpr> 
      (??{ ++$cnt <= $maxcnt ? 
       ($visible_only ? 
         ($aryinput[$lcnt-1] le ' ' ? 
          '(?!)' 
         : '[^\x{0}-\x{20}]' 
        ) 
        : '.' 
       ) 
       : '(?!)' 
      }) 
    ) 
) 

Perl-Code:

use strict; 
use warnings; 

my $target = 
    " 
    one mismatch: MSTCH, AATCH, MACCH, etc. and two mismatches: ATTCH, MGGCH, 
    MA1CH T23S 
    M.1CH T23S 
    MAT1 H2T3IS 
    0M[T2CH THaS 
    0M[T2CH THaS 
    MA1CH THIS 
    MATCH THIS 
    MATCHT1IS 
    MA1CH THIS 
    MAT1H THIb 
    MATCH THIS 
    MArCH THIS 
    AATCH THIS 
    [()+?.*{}|] 
    [()X?.*{}|] 
    [()+?.SS}|] 
    "; 

my @aryinput =(); 
my ($rx, $find, $visible_only, $len, $cnt, $mincnt, $maxcnt, $lcnt) = ('', '',0,0,0,0,0,0); 

my @TestRuns = (
    { find => 'MATCH THIS', visible => 1, min => 0, max => 3 }, 
    { find => 'MATCH', visible => 1, min => 0, max => 3 }, 
    { find => 'MATCH THIS', visible => 0, min => 0, max => 3 }, 
    { find => 'MATCH', visible => 0, min => 2, max => 3 }, 
    { find => 'MATCH', visible => 0, min => 1, max => 1 }, 
    { find => '[()+?.*{}|]', visible => 1, min => 1, max => 3 }, 
); 

for (@TestRuns) 
{ 
    GetParms($_); 
    SetFindArray($find); 

    print "\nFind($len), ", ($visible_only ? "not counting control char" : "counting any char"), ", minmax($mincnt,$maxcnt):\n'$find'\n"; 
    while($target =~ /$rx/g) 
    { 
     print " cnt($cnt) : '$&'\n"; 
    } 
} 

# ================================== 
# ================================== 

sub GetParms 
{ 
    my ($href) = @_; 
    ($find, $visible_only, $mincnt, $maxcnt) = 
    ($$href{find}, $$href{visible}, $$href{min}, $$href{max}); 
} 
sub SetFindArray 
{ 
    my ($inp) = @_; 
    @aryinput =(); 
    @aryinput = map { s/([\\().?*+{}|\[\]])/\\$1/; $_ } split '', $inp; 
    $len = @aryinput; 
    $rx = qr/(?s)(?{ $cnt = 0; $lcnt = 0 })(?s)(?:(?>(??{ $aryinput[$lcnt++] })|(?&getexpr))){$len}(??{ $cnt >= $mincnt && $cnt <= $maxcnt ? '' : '(?!)' })(?(DEFINE)(?<getexpr>(??{ ++$cnt <= $maxcnt ? 
        ($visible_only ? 
          ($aryinput[$lcnt-1] le ' ' ? 
           '(?!)' 
          : '[^\x{0}-\x{20}]' 
         ) 
         : '.' 
        ) 
        : '(?!)' 
       })))/; 
} 

Ausgang:

Find(10), not counting control char, minmax(0,3): 
'MATCH THIS' 
    cnt(3) : 'MA1CH T23S' 
    cnt(1) : 'MA1CH THIS' 
    cnt(2) : 'MAT1H THIb' 
    cnt(0) : 'MATCH THIS' 
    cnt(1) : 'MArCH THIS' 
    cnt(1) : 'AATCH THIS' 

Find(5), not counting control char, minmax(0,3): 
'MATCH' 
    cnt(1) : 'MSTCH' 
    cnt(1) : 'AATCH' 
    cnt(1) : 'MACCH' 
    cnt(2) : 'ATTCH' 
    cnt(2) : 'MGGCH' 
    cnt(1) : 'MA1CH' 
    cnt(2) : 'M.1CH' 
    cnt(3) : 'M[T2C' 
    cnt(3) : 'M[T2C' 
    cnt(1) : 'MA1CH' 
    cnt(0) : 'MATCH' 
    cnt(0) : 'MATCH' 
    cnt(1) : 'MA1CH' 
    cnt(1) : 'MAT1H' 
    cnt(0) : 'MATCH' 
    cnt(1) : 'MArCH' 
    cnt(1) : 'AATCH' 

Find(10), counting any char, minmax(0,3): 
'MATCH THIS' 
    cnt(3) : 'MA1CH T23S' 
    cnt(2) : 'MA1CH  THIS' 
    cnt(1) : 'MATCH  THIS' 
    cnt(1) : 'MA1CH THIS' 
    cnt(2) : 'MAT1H THIb' 
    cnt(0) : 'MATCH THIS' 
    cnt(1) : 'MArCH THIS' 
    cnt(1) : 'AATCH THIS' 

Find(5), counting any char, minmax(2,3): 
'MATCH' 
    cnt(3) : ' ATTC' 
    cnt(2) : 'MGGCH' 
    cnt(2) : 'M.1CH' 
    cnt(2) : 'MAT1 ' 
    cnt(3) : 'M[T2C' 
    cnt(3) : 'M[T2C' 

Find(5), counting any char, minmax(1,1): 
'MATCH' 
    cnt(1) : 'MSTCH' 
    cnt(1) : 'AATCH' 
    cnt(1) : 'MACCH' 
    cnt(1) : 'MA1CH' 
    cnt(1) : 'MA1CH' 
    cnt(1) : 'MA1CH' 
    cnt(1) : 'MAT1H' 
    cnt(1) : 'MArCH' 
    cnt(1) : 'AATCH' 

Find(11), not counting control char, minmax(1,3): 
'[()+?.*{}|]' 
    cnt(1) : '[()X?.*{}|]' 
    cnt(2) : '[()+?.SS}|]' 

Answer 4

Wenn die gesuchte Zeichenfolge sollte die gleiche Länge (Mismatches dh nur erlaubt), wie in einem späteren Kommentar erwähnt, können Sie Hamming-Distanz verwenden, was sehr schnell ist:

#!/usr/bin/perl 

use strict; 
use warnings; 

my $find = "MATCH"; 
my $search = "stringisMATTHhere"; 

my $max_distance = 2; 

for my $offset (0..length($search)-length($find)) { 
    my $hd = hd($find,substr($search,$offset,length($find))); 
    if ($hd <= $max_distance) { 
    print substr($search,$offset,length($find)),"\n"; 
    } 
} 

# assumes byte mode 
sub hd { 
    return ($_[0]^$_[1]) =~ tr/\001-\255//; 
}