给定像这样的一对字符串。
my $s1 = "ACTGGA";
my $s2 = "AGTG-A";
# Note the string can be longer than this.
我想在
$s1
中找到与$s2
不同的位置和字符。
在这种情况下,答案是:
#String Position 0-based
# First col = Base in S1
# Second col = Base in S2
# Third col = Position in S1 where they differ
C G 1
G - 4
我可以通过
substr()
轻松实现这一目标。但速度慢得可怕。
通常我需要比较数百万个这样的对。
有没有快速的方法来实现这一目标?
Stringwise ^ 是你的朋友:
use strict;
use warnings;
my $s1 = "ACTGGA";
my $s2 = "AGTG-A";
my $mask = $s1 ^ $s2;
while ($mask =~ /[^\0]/g) {
print substr($s1,$-[0],1), ' ', substr($s2,$-[0],1), ' ', $-[0], "\n";
}
说明:
^
(异或)运算符在字符串上使用时,返回由每个字符的数值的每一位异或的结果组成的字符串。将示例分解为等效代码:
"AB" ^ "ab"
( "A" ^ "a" ) . ( "B" ^ "b" )
chr( ord("A") ^ ord("a") ) . chr( ord("B") ^ ord("b") )
chr( 65 ^ 97 ) . chr( 66 ^ 98 )
chr(32) . chr(32)
" " . " "
" "
这里的有用功能是,当且仅当两个字符串在给定位置具有相同字符时,才会出现空字符(
"\0"
)。因此,^
可用于在一次快速操作中有效地比较两个字符串的每个字符,并且可以在结果中搜索非空字符(表示差异)。可以在标量上下文中使用 /g 正则表达式标志重复搜索,并使用 $-[0]
找到每个字符差异的位置,它给出了最后一次成功匹配的开头的偏移量。
在完整的字符串上使用二进制位操作。
像
$s1 & $s2
或 $s1 ^ $s2
这样的东西运行得非常快,并且可以处理任意长度的字符串。
2012 年感恩节假期我很无聊,回答了这个问题等等。它将适用于相同长度的字符串。如果他们不这样做,它也会起作用。我添加了一个帮助,选择处理只是为了好玩。我想有人可能会觉得它有用。 如果您是 PERL 新手,请添加不知道。不要将 DATA 下面的脚本中的任何代码添加到程序中。 玩得开心。
./diftxt -h
usage: diftxt [-v ] string1 string2
-v = Verbose
diftxt [-V|--version]
diftxt [-h|--help] "This help!"
Examples: diftxt test text
diftxt "This is a test" "this is real"
Place Holders: space = "·" , no charater = "ζ"
猫./diftxt -----------切✂----------
#!/usr/bin/perl -w
use strict;
use warnings;
use Getopt::Std;
my %options=();
getopts("Vhv", \%options);
my $helptxt='
usage: diftxt [-v ] string1 string2
-v = Verbose
diftxt [-V|--version]
diftxt [-h|--help] "This help!"
Examples: diftxt test text
diftxt "This is a test" "this is real"
Place Holders: space = "·" , no charater = "ζ"';
my $Version = "inital-release 1.0 - Quincey Craig 11/21/2012";
print "$helptxt\n\n" if defined $options{h};
print "$Version\n" if defined $options{V};
if (@ARGV == 0 ) {
if (not defined $options{h}) {usage()};
exit;
}
my $s1 = "$ARGV[0]";
my $s2 = "$ARGV[1]";
my $mask = $s1 ^ $s2;
# setup unicode output to STDOUT
binmode DATA, ":utf8";
my $ustring = <DATA>;
binmode STDOUT, ":utf8";
my $_DIFF = '';
my $_CHAR1 = '';
my $_CHAR2 = '';
sub usage
{
print "\n";
print "usage: diftxt [-v ] string1 string2\n";
print " -v = Verbose \n";
print " diftxt [-V|--version]\n";
print " diftxt [-h|--help]\n\n";
exit;
}
sub main
{
print "\nOrig\tDiff\tPos\n----\t----\t----\n" if defined $options{v};
while ($mask =~ /[^\0]/g) {
### redirect stderr to allow for test of empty variable with error message from substr
open STDERR, '>/dev/null';
if (substr($s2,$-[0],1) eq "") {$_CHAR2 = "\x{03B6}";close STDERR;} else {$_CHAR2 = substr($s2,$-[0],1)};
if (substr($s2,$-[0],1) eq " ") {$_CHAR2 = "\x{00B7}"};
$_CHAR1 = substr($s1,$-[0],1);
if ($_CHAR1 eq "") {$_CHAR1 = "\x{03B6}"} else {$_CHAR1 = substr($s1,$-[0],1)};
if ($_CHAR1 eq " ") {$_CHAR1 = "\x{00B7}"};
### Print verbose Data
print $_CHAR1, "\t", $_CHAR2, "\t", $+[0], "\n" if defined $options{v};
### Build difference list
$_DIFF = "$_DIFF$_CHAR2";
### Build mask
substr($s1,"$-[0]",1) = "\x{00B7}";
} ### end loop
print "\n" if defined $options{v};
print "$_DIFF, ";
print "Mask: \"$s1\"\n";
} ### end main
if ($#ARGV == 1) {main()};
__DATA__
我看到你正在尝试对 DNA 进行测序。您可以使用 bioperl 库为您的应用程序找到更好的算法。
这是您可以获得的最简单的表格
my $s1 = "ACTGGA";
my $s2 = "AGTG-A";
my @s1 = split //,$s1;
my @s2 = split //,$s2;
my $i = 0;
foreach (@s1) {
if ($_ ne $s2[$i]) {
print "$_, $s2[$i] $i\n";
}
$i++;
}