Есть ли способ "разрешить" Perl RegEx игнорировать 1 символ за раз при попытке сопоставления?

Question

По сути, у меня есть несколько файлов, каждый из которых содержит несколько строк текста, и я заинтересован в том, чтобы найти конкретную последовательность из 7 букв и подсчитать, сколько раз они появляются на файл, используя некоторые основные регулярные выражения на Perl (v5. 24,1).

Пока проблем нет, но «хитрая» часть заключается в том, что если одна из этих семи букв не соответствует моему шаблону, я бы тоже хотел посчитать ее (при условии, что она всего одна).

Шаблоны, которые я ищу: 'CCCAGGT', 'CCCAGTT', 'CCCAGCT', and 'CCCAGAT'.

Примеры несоответствующих текстов, которые я хотел бы посчитать:

line1 - AGGCTCAGGAG'CCCATGT'GGGCGGACCCAT --> Count as 'CCCAGGT'
line2 - CGGCTCAGGAG'CCCGGGT'GGGCGGTCCCAT --> Count as 'CCCAGGT'

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

Итак, знаете ли вы, можно ли "сказать" Perl, что я могу допустить 1 несоответствие в последовательности при использовании оператора =~ m/? ИЛИ другую функцию для использования?

Большое спасибо за вашу помощь!

  if ($elements[0] =~ m/CCCAGGT/){
    $mutg = $mutg + $elements[1];
  }
  elsif ($elements[0] =~ m/CCCAGTT/){
    $mutt = $mutt + $elements[1];
  }
  elsif ($elements[0] =~ m/CCCAGAT/){
    $muta = $muta + $elements[1];
  }
  elsif ($elements[0] =~ m/CCCAGCT/){
    $mutc = $mutc + $elements[1];
  }
  else {
    if ($elements[0] =~ m/.CCAGGT/){
      $mutg = $mutg + $elements[1];
    }
    elsif ($elements[0] =~ m/.CCAGTT/){
    $mutt = $mutt + $elements[1];
    }
    elsif ($elements[0] =~ m/.CCAGAT/){
      $muta = $muta + $elements[1];
    }
    elsif ($elements[0] =~ m/.CCAGCT/){
      $mutc = $mutc + $elements[1];
    }
    else {
      [[AGAIN BUT WITH THE "." IN THE SECOND POSITION AND SO ON]]
    }                         
  }

Answer 1

Это может быть возможно с регулярным выражением, но это будет слишком сложно, регулярное выражение не предназначено для нечеткого сопоставления. Вы можете рассмотреть Text :: Fuzzy . Нормальный интерфейс потребует, прежде всего, как-то превратить ваши строки в возможные последовательности для рассмотрения.

use strict;
use warnings;
use Text::Fuzzy;
my $fuzzy = Text::Fuzzy->new('CCCAGGT', max => 1);
my @matches = $fuzzy->nearestv(\@possible);

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

Answer 2

Чтобы просто проверить, есть ли совпадение (в отличие от поиска ближайшего совпадения), мы могли бы динамически строить шаблоны (.CCAGGT, C.CAGGT и т. Д.).

my $target_seq = "CCCAGGT";

my @parts = map quotemeta, split //, $target_seq;
my $fuzzy_pat =
   join "|",
      map { join("", @parts[0..$_-1], ".", @parts[$_+1..$#parts]) }
         0..$#parts;

my $fuzzy_re = qr/$fuzzy_pat/;

Это может быть расширено для проверки нескольких последовательностей одновременно, если не важно, какая последовательность найдена.

use List::Util qw( uniq );

my @target_seqs = qw( CCCAGGT CCCAGTT CCCAGAT CCCAGCT );

my @fuzzy_pats;
for my $pat (@target_seqs) {
   my @parts = map quotemeta, split //, $pat;
   for my $i (0..$#parts) {
      push @fuzzy_pats, join("", @parts[0..$i-1], ".", @parts[$i+1..$#parts]);
   }
}

my $fuzzy_pat = join "|", sort uniq @fuzzy_pats;
my $fuzzy_re = qr/$fuzzy_pat/;

$mtg += $elements[1] if $elements[0] =~ $fuzzy_re;