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