Perl найти количество совпадающих 2 символов в строке - PullRequest
Новая
       40

Perl найти количество совпадающих 2 символов в строке

1 голос
/ 18 ноября 2011

есть ли в perl (не bioperl) метод для определения числа каждых 2 последовательных букв

т.е.: число AA, AC,AG,AT,CC,CA... в такой последовательности: 

$sequence = 'AACGTACTGACGTACTGGTTGGTACGA'

ps: мы можем сделать это вручную, используя регулярное выражение, т.е. $ GC = ($ sequence = ~ s / GC / GC / g), которое возвращает номер GC в последовательности. Мне нужен автоматический и общий способ спасибо в Advane

Ответы [ 3 ]

3 голосов
/ 18 ноября 2011

Близко к ответу TLP, но без подстановки: 

my $sequence = 'AACGTACTGACGTACTGGTTGGTACGA';
my @dinucs = qw(AA AC AG AT CC CG);
my %count = map{$_ => 0}@dinucs;

for my $dinuc (@dinucs) {
    while($sequence=~/$dinuc/g) {
        $count{$dinuc}++;
    }
}

Контрольный показатель: 

my $sequence = 'AACGTACTGACGTACTGGTTGGTACGA';
my @dinucs = qw(AA AC AG AT CC CG);
my %count = map{$_ => 0}@dinucs;

my $count = -3;
my $r = cmpthese($count, {
        'match' => sub {
            for my $dinuc (@dinucs) {
               while($sequence=~/$dinuc/g) {
                    $count{$dinuc}++;
               }
            }
        },
        'substitute' => sub {
            for my $dinuc (@dinucs) {
                $count{$dinuc} = ($sequence =~ s/\Q$dinuc\E/$dinuc/g);
            }
         }
});

вывод: 

              Rate substitute      match
substitute 13897/s         --       -11%
match      15622/s        12%         --
3 голосов
/ 18 ноября 2011

Вы меня смущали некоторое время, но я понимаю, что вы хотите считать динуклеотидов в данной строке.

Код: 

my @dinucs = qw(AA AC AG CC CA CG);
my %count;
my $sequence = 'AACGTACTGACGTACTGGTTGGTACGA';

for my $dinuc (@dinucs) {
    $count{$dinuc} = ($sequence =~ s/\Q$dinuc\E/$dinuc/g);
}

Выход из Данные :: Дампер : 

$VAR1 = {
          "AC" => 5,
          "CC" => "",
          "AG" => "",
          "AA" => 1,
          "CG" => 3,
          "CA" => ""
        };
0 голосов
/ 16 декабря 2011

Regex работает, если вы осторожны, но есть простое решение с использованием substr, которое будет быстрее и более гибким.

(Начиная с этой публикации, решение регулярных выражений, помеченное как принятое, не сможет правильно подсчитать динуклеотиды в повторяющихся областях, таких как «AAAA ...», которых много в естественных последовательностях. Как только вы сопоставите «AA», Поиск по регулярному выражению возобновляется с третьего символа, пропуская средний динуклеотид 'AA'. Это не влияет на другие динуки, поскольку, если у вас есть 'AC' в одной позиции, вы гарантированно не будете иметь его в следующей базе, естественно. Конкретная последовательность, приведенная в вопросе, не пострадает от этой проблемы, поскольку три раза подряд ни одна база не появляется.)

Метод, который я предлагаю, является более гибким в том смысле, что он может считать слова любой длины; Расширить метод регулярных выражений до более длинных слов сложно, поскольку для получения точного счета вам нужно выполнять еще больше упражнений с вашим регулярным выражением. 

sub substrWise {
    my ($seq, $wordLength) = @_;

    my $cnt = {};

    my $w;
    for my $i (0 .. length($seq) - $wordLength) {
        $w = substr($seq, $i, $wordLength);
        $cnt->{$w}++;
    }

    return $cnt;
}

sub regexWise {
    my ($seq, $dinucs) = @_;

    my $cnt = {};
    for my $d (@$dinucs) {
        if (substr($d, 0,1) eq substr($d, 1,1) ) {
            my $n = substr($d, 0,1);
            $cnt->{$d} = ($seq =~ s/$n(?=$n)/$n/g); # use look-ahead
        } else {
            $cnt->{$d} = ($seq =~ s/$d/$d/g);
        }
    }

    return $cnt;
}


my @dinucs = qw(AA AC AG AT CA CC CG CT GA GC GG GT TA TC TG TT);

my $sequence = 'AACGTACTGACGTACTGGTTGGTACGA';

use Test::More tests => 1;
my $rWise = regexWise($sequence, \@dinucs);
my $sWise = substrWise($sequence, 2);
$sWise->{$_} //= '' for @dinucs; # substrWise will not create keys for words not found
# this seems like desirable behavior IMO, 
# but i'm adding '' to show that the counts match
is_deeply($rWise, $sWise, 'verify equivalence');

use Benchmark qw(:all);
cmpthese(100000, {
    'regex' => sub {
        regexWise($sequence, \@dinucs);
    },
    'substr' => sub {
        substrWise($sequence, 2);
    }

Выход: 

1..1
ok 1 - verify equivalence
          Rate  regex substr
regex  11834/s     --   -85%
substr 76923/s   550%     --

Для более длинных последовательностей (10-100kbase) преимущество не столь выражено, но оно все равно выигрывает примерно на 70%.

...