Knuth Morris Pratt Perl中的算法實現

Question

我想在Perl中實現Knuth Morris Pratt algorithm。以下是我的代碼，我將該算法的Perl第一版中的Mastering Algorithms引用。當我運行代碼時，它會打印-1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1。我哪裏錯了？

代碼：

#!/usr/local/bin/perl 

#text 
my $seq = "babacbadbbac"; 

#pattern 
my $motif = "acabad"; 

#pass the text and pattern to knuth_morris_pratt subroutine 
my @res = knuth_morris_pratt($seq, $motif); 

#print the result 
print "The resulting array is:"; 
print "@res"; 

#computation of the prefix subroutine 
sub knuth_morris_pratt_next 
{ 
    my($P) = @_; #pattern 
    use integer; 
    my ($m, $i, $j) = (length $P, 0, -1); 
    my @next; 
    for ($next[0] = -1; $i < $m;) { 
     # Note that this while() is skipped during the first for() pass. 
     while ($j > -1 && substr($P, $i, 1) ne substr($P, $j, 1)) { 
     $j = $next[$j]; 
     } 
     $i++; 
     $j++; 
     $next[$i] = substr($P, $j, 1) eq substr($P, $i, 1) ? $next[$j] : $j; 
    } 
    return ($m, @next); # Length of pattern and prefix function. 
} 

#matcher subroutine 
sub knuth_morris_pratt 
{ 
    my ($T, $P) = @_; # Text and pattern. 
    use integer; 
    my ($m,@next) = knuth_morris_pratt_next($P); 
    my ($n, $i, $j) = (length($T), 0, 0); 
    #my @next; 
    my @val; 
    my $k=0; 
    while ($i < $n) 
    { 
     while ($j > -1 && substr($P, $j, 1) ne substr($T, $i, 1)) 
     { 
     $j = $next[$j]; 
     } 
     $i++; 
     $j++; 
     if($j>=$m) 
     { 
      $val[$k]= $i - $j; # Match. 
     } 
     else 
     { 
      $val[$k]=-1; # Mismatch. 
     } 
     $k++; 
    } 
    return @val; 
} 

Answer 1

你實現KMP算法返回與序列的每個位置的主題不匹配以及匹配它確實位置的指數-1的數組。

例如，如果你改變了基序爲 「acbad」 陣列將還包含一個3：

0 1 2 3 4 5 6 7 8 9 10 11 | index 
"b a b a c b a d b b a c" | seq 
     "a c b a d"    | motif 

$> perl mq.pl "babacbadbbac" "acabad" 
The resulting array is: 
[-1] [-1] [-1] [-1] [-1] [-1] [-1] [-1] [-1] [-1] [-1] [-1] 

$> perl mq.pl "babacbadbbac" "acbad" 
Match at index:3 
The resulting array is: 
[-1] [-1] [-1] [-1] [-1] [-1] [-1] [3] [-1] [-1] [-1] [-1] 


$> perl mq.pl "babacbadbbac" "ac" 
Match at index:3 
Match at index:10 
The resulting array is: 
[-1] [-1] [-1] [-1] [3] [-1] [-1] [-1] [-1] [-1] [-1] [10] 

---

修改的碼

#!/usr/local/bin/perl 

my($seq,$motif) = @ARGV; 

die "seq and motif required..." unless $seq and $motif; 
die "motif should be <= seq ..." unless length($motif) <= length($seq); 

#pass the text and pattern to knuth_morris_pratt subroutine 
my @res = knuth_morris_pratt($seq, $motif); 

#print the result 
print "The resulting array is:\n"; 
#print "@res"; 
print "[".join("] [",@res)."] \n"; 
#computation of the prefix subroutine 
sub knuth_morris_pratt_next 
{ 
    my($P) = @_; #pattern 
    use integer; 
    my ($m, $i, $j) = (length $P, 0, -1); 
    my @next; 
    for ($next[0] = -1; $i < $m;) { 
     # Note that this while() is skipped during the first for() pass. 
     while ($j > -1 && substr($P, $i, 1) ne substr($P, $j, 1)) { 
     $j = $next[$j]; 
     } 
     $i++; 
     $j++; 
     $next[$i] = substr($P, $j, 1) eq substr($P, $i, 1) ? $next[$j] : $j; 
    } 
    return ($m, @next); # Length of pattern and prefix function. 
} 

#matcher subroutine 
sub knuth_morris_pratt 
{ 
    my ($T, $P) = @_; # Text and pattern. 
    use integer; 
    my ($m,@next) = knuth_morris_pratt_next($P); 
    my ($n, $i, $j) = (length($T), 0, 0); 
    #my @next; 
    my @val; 
    my $k=0; 
    while ($i < $n) 
    { 
     while ($j > -1 && substr($P, $j, 1) ne substr($T, $i, 1)) 
     { 
     $j = $next[$j]; 
     } 
     $i++; 
     $j++; 
     if($j>=$m) 
     { 
      $val[$k]= $i - $j; # Match. 
      print "Match at index:".$val[$k]." \n"; 
     } 
     else 
     { 
      $val[$k]=-1; # Mismatch. 
     } 
     $k++; 
    } 
    return @val; 
}