Schnelle Möglichkeit, den Unterschied zwischen zwei gleichlangen Strings in Perl zu finden

Question

Gegebene Paare von Strings wie dieser.

my $s1 = "ACTGGA"; 
    my $s2 = "AGTG-A"; 

    # Note the string can be longer than this. 

Ich mag würde in $s1 Position und Charakter finden, wo es mit $s2 unterscheidet. In diesem Fall wäre die Antwort:

#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 

ich das leicht mit substr() erreichen kann. Aber es ist schrecklich langsam. Normalerweise muss ich Millionen solcher Paare vergleichen.

Gibt es einen schnellen Weg, um das zu erreichen?

Answer 1

Stringwise^ist dein Freund:

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"; 
} 

ERKLÄRUNG:

Die ^ (exklusiv oder) Operator, wenn auf Strings verwendet, gibt eine Zeichenfolge, bestehend aus dem Ergebnis eines exklusiven oder auf jedem Bit des numerischen Werts jedes Zeichens. Bricht ein Beispiel in äquivalenten Code:

"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) 
" " . " " 
" " 

Die nützliche Funktion dieses hier ist, dass ein NUL-Zeichen ("\0") treten auf, wenn und nur dann, wenn die beiden Strings den gleichen Charakter in einer bestimmten Position haben. So kann ^ verwendet werden, um effizient jedes Zeichen der beiden Zeichenfolgen in einer schnellen Operation zu vergleichen, und das Ergebnis kann nach Nicht-Null-Zeichen durchsucht werden (was einen Unterschied anzeigt). Die Suche kann mit dem Flag/g regex im Skalarkontext wiederholt werden, und die Position jeder gefundenen Zeichendifferenz wird mit $-[0] ermittelt, was den Offset des Beginns der letzten erfolgreichen Übereinstimmung angibt.

Answer 2

Dies ist die einfachste Form Sie

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++; 
} 

Answer 3

Binäre Bit ops auf den kompletten Strings bekommen.

Dinge wie $s1 & $s2 oder $s1^$s2 laufen unglaublich schnell und arbeiten mit Strings beliebiger Länge.

Answer 4

Ich war auf Thanksgiving-Pause 2012 gelangweilt und beantwortete die Frage und mehr. Es wird auf gleichlangen Saiten funktionieren. Es wird funktionieren, wenn sie es nicht sind. Ich habe eine Hilfe hinzugefügt, die Handhabung nur zum Spaß. Ich dachte, jemand könnte es nützlich finden. Wenn Sie PERL neu sind, wissen Sie nicht. Fügen Sie keinen Code in Ihrem Skript unter DATA zum Programm hinzu. Viel Spaß.

./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 = "ζ" 

Katze ./diftxt ----------- Schnitt ✂ ----------

#!/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__