perl中的高效子串匹配

我正在寻找一个有效的解决方案,找到一个字符串中最长的子字符串,容忍主字符串中的n个不匹配

例如：
主弦

> AGACGTACTACTCTACTAGATGCA * TACTCTAC *
> AGACGTACTACTCTACTAGATGCA * TACTCTAC *
> AGACGTACTACTCTACAAGATGCA * TACTCTAC *
> AGACGTACTACTTTACAAGATGCA * TACTCTAC *

搜索字符串：

> TACTCTACT：这应该被视为与所有上述主要字符串匹配.

另外,我可能会遇到子串的一部分位于主字符串末尾的情况,我也想选择它.

如果你能给出一些指示,我将不胜感激.

PS：我将有一个搜索字符串和大约1亿个主字符串来搜索子字符串.

谢谢！
-Abhi

解决方法

use strict;
use warnings;
use feature qw( say );

sub match {
   my ($s,$t,$max_x) = @_;

   my $m = my @s = unpack('(a)*',$s);
   my $n = my @t = unpack('(a)*',$t);

   my @length_at_k     = ( 0 ) x ($m+$n);
   my @mismatches_at_k = ( 0 ) x ($m+$n);
   my $offset = $m;

   my $best_length = 0;
   my @solutions;
   for my $i (0..$m-1) {
      --$offset;

      for my $j (0..$n-1) {
         my $k = $j + $offset;

         if ($s[$i] eq $t[$j]) {
            ++$length_at_k[$k];
         }
         elsif ($length_at_k[$k] > 0 && $mismatches_at_k[$k] < $max_x) {
            ++$length_at_k[$k];
            ++$mismatches_at_k[$k];
         }
         else {
            $length_at_k[$k] = 0;
            $mismatches_at_k[$k] = 0;
         }

         my $length = $length_at_k[$k] + $max_x - $mismatches_at_k[$k];
         $length = $i+1 if $length > $i+1;

         if ($length >= $best_length) {
            if ($length > $best_length) {
               $best_length = $length;
               @solutions = ();
            }

            push @solutions,$i-$length+1;
         }
      }
   }

   return map { substr($s,$_,$best_length) } @solutions;
}

say for match('AABBCC','DDBBEE',2);

输出：

AABB
ABBC
BBCC

perl中的高效子串匹配

解决方法

猜你在找的Perl相关文章