Эффективное сопоставление подстроки в perl - PullRequest
Новая
       45

Эффективное сопоставление подстроки в perl

7 голосов
/ 07 июня 2011

Я ищу эффективное решение для поиска максимально длинной подстроки в строке, допускающей n несоответствия в основной строке

Например: основная строка

  1. AGACGTAC TACTCTACT AGATGCA * TACTCTAC *
  2. AGACGTAC TACTCTACT AGATGCA * TACTCTAC *
  3. AGACGTAC TACTCTACA AGAT
  4. AGACGTAC TACTTTACA AGATGCA * TACTCTAC *

Строка поиска:

  1. TACTCTACT: это следует рассматривать как соответствие всемвышеупомянутые основные строки.

Также может быть случай, когда часть подстроки находится в конце основной строки, и я хотел бы также это поднять.

Iбыл бы признателен, если бы вы могли дать несколько указателей.

PS: у меня будет одна строка поиска и около 100 миллионов основных строк для поиска подстроки.

Спасибо!-Abhi

Ответы [ 2 ]

11 голосов
/ 07 июня 2011

Я не уверен, что это то, что вам нужно, но в BioPerl есть инструмент приблизительного набора, который называется Bio::Grep::Backend::Agrep:

Bio :: Grep ::Backend :: Agrep ищет запрос с agrep

И agrep - это «приблизительный grep».AFAIK, это создает базу данных, а затем использует эту базу данных, чтобы ускорить поиск, так что это похоже на то, что вы ищете.

Похоже, вы работаете с последовательностями ДНК, поэтому у вас, вероятно, уже установлен BioPerl.

Вы также можете попробовать использовать String::Approx напрямую:

Расширение Perl для приблизительного соответствия (нечеткое соответствие)

Я подозреваючто Bio::Grep::Backend::Agrep будет быстрее и лучше подходит для вашей задачи.

3 голосов
/ 07 июня 2011 
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
...