Несоответствие количества perl между двумя строками

Мне нужно просто посчитать несоответствие между двумя строками. Скажем так:

my $s1 = "ATCG";
my $s2 = "ATTG"; 

Это должно дать: 1 как несоответствие. Не нужно искать позицию или какие несовпадения.

Я искал быстрый способ сделать. Я думал, что разделение на массивы и сопоставление в цикле или использование substr для сопоставления каждой позиции может быть медленным, потому что необходимо проверить более миллиарда пар. Спасибо


person SSh    schedule 10.10.2015    source источник
comment
Всегда ли два входа одинаковой длины? Если нет, ABCD и ACD имеют разницу в 1 или что-то еще? Даже если это так, есть ли разница между ABCDEF и ACDEFB в 2, 5 или что-то еще?   -  person hobbs    schedule 10.10.2015
comment
Если вы согласны, то немного более search.cpan.org/ dist / Text-Levenshtein / lib / Text / Levenshtein.pm   -  person Sobrique    schedule 10.10.2015


Ответы (1)


Просто выполните XOR двух строк вместе. Каждый символ NUL в результате представляет позицию, в которой символы в обеих строках совпадают.

my ($s1, $s2) = qw( ATCG ATTG );

my $count = ( $s1 ^ $s2 ) =~ tr/\0//c;

print "$count\n";   # Prints "1"

Примечание. Если вы собираетесь многократно сравнивать строку, передайте ее и ту, с которой вы сравниваете, в utf8::downgrade, чтобы убедиться, что ^ работает максимально быстро.

utf8::downgrade($s1);  # Change the internal format in which
utf8::downgrade($s2);  #   the strings are stored to speed up $s1^$s2.

Это бесполезно / расточительно, если любая строка содержит символы UNICODE выше U + 00FF.

person ikegami    schedule 10.10.2015
comment
хороший ответ. Можете ли вы рассказать об использовании ^ в вашем коде и о том, как это работает? - person mkHun; 10.10.2015
comment
XOR - это побитовый оператор, который находит разницу между парами битов. Таким образом, возникает вопрос о подсчете байтов с 1 битами или тех, которые не полностью состоят из нулевых битов. - person ikegami; 10.10.2015
comment
Фантастическое решение. Я выглядел лаконичным, как этот. Спасибо - person SSh; 10.10.2015
comment
Я сформулировал это так, что это будет полезно и другим - person ikegami; 10.10.2015
comment
@ikegami: Будут ли проблемы с ATCG, я использую его только для ДНК? - person SSh; 12.10.2015
comment
Сравнение будет работать с любыми персонажами. Переход на более раннюю версию может помочь в описываемой мной ситуации. Переход на более раннюю версию может повредить в описанной мной ситуации. Латинские буквы без ударения - ниже U + 0100. - person ikegami; 12.10.2015
comment
@ikegami Можно ли сохранить совпадающую строку в массиве или другом типе данных из вашего ответа.? Нравится @data = ($s1 ^ $s2) =~tr///; - person mkHun; 20.10.2015