1

Perl でKnuth Morris Pratt アルゴリズムを実装しようとしています。以下は私のコードです。アルゴリズムについては、Mastering Algorithms in Perl First Edition を参照しました。コードを実行すると、結果として -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; 
}
4

1 に答える 1

1

KMP アルゴリズムの実装は、モチーフが一致しない seq の各位置と、一致する位置の一致のインデックスを含む配列を返します。

たとえば、モチーフを「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; 
}
于 2013-05-12T00:30:48.510 に答える