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
}
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;
}
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 2.892 seconds using v1.01-cache-2.11-cpan-b16cb0d3907 )