Algorithm-RabinKarp

 view release on metacpan or  search on metacpan

lib/Algorithm/RabinKarp.pm  view on Meta::CPAN


For best results, you will want to create a code generator that filters
your data to remove all unnecessary information. For example, in a large
english document, you should probably remove all white space, as well
as removing all capitalization.

=head1 INTENT

By preprocessing your document with the Rabin Karp hashing algorithm,
it makes it possible to create a "fingerprint" of your document (or documents), 
and then perform multiple searches for fragments contained within your document
database.

Schleimer, Wilkerson, and Aiken suggest preproccessing to remove
unnecessary information (like whitespace), as well as known redundent information
(like, say, copyright notices or other boilerplate that is 'acceptable'.)

They also suggest a post processing pass to reduce data volume, using a technique
called winnowing (see the link at the end of this documentation.)

=head1 METHODS

rabin.pl  view on Meta::CPAN

}

for my $rec (sort {  
                     $occurances{ $b->[HASH] } <=> $occurances{ $a->[HASH] }
                  or $a->[HASH]                <=> $b->[HASH]
                  or span($b)                  <=> span($a)
                 } @newrec) { ### Emitting Report ===[%]       done
  my ($hash, $file_name, $start_offset, $end_offset, $s, $e) = @$rec;
  dumpit() if ($last ne $hash);
  $last = $hash;
  push @{ $chunks{emit_fragment($file_name,$start_offset,$end_offset)}{$file_name}}, [$s,$e];
}
dumpit();

sub span {
  my $rec = shift;
  $rec->[HASH_END] - $rec->[HASH_START] + 1
}

use Fcntl qw(SEEK_SET);

sub emit_fragment {
  my ($file, $start, $end) = @_;
  open(my $fh, '<', $file)
    or die "Can't open $file: $!";
  my $bytes = $end - $start + 1;
  my $buf;
  seek($fh, $start, SEEK_SET);
  read $fh, $buf, $bytes;
  close $fh;
  return $buf;
}

t/hash.t  view on Meta::CPAN

is @values, $kgrams, "We get length - k + 1 kgram hash values";

my %kgram_seen;
my %source_seen;

#use Data::Dumper; warn Dumper( [
#map { [ $_->[0], substr($source, $_->[1], $_->[2]) ] }
#map { [ $_->[0], $_->[1], $_->[2] - $_->[1] + 1]} @values ]);

for my $i (0..(length($source)-$k)) {
  my $fragment = substr($source, $i, $k);
  my $occurences = $source_seen{$fragment}++;
  my $kgram = shift @{$values[$i]};
  is $kgram_seen{$kgram}++, $occurences, 
    "$fragment has occurred $occurences times.";
    
  my ($start, $end) = @{$values[$i]};
  is_deeply [$start, $end], [$i, $i + $k - 1], 
    "$fragment position correctly recorded";
  is substr($source, $start, $end - $start + 1 ), $fragment,
    "The recorded offsets correctly select $fragment";
}



( run in 0.589 second using v1.01-cache-2.11-cpan-b16cb0d3907 )