File Coverage

blib/lib/Text/Bloom.pm

Criterion	Covered	Total	%
statement	113	141	80.1
branch	16	36	44.4
condition	2	6	33.3
subroutine	13	17	76.4
pod	9	13	69.2
total	153	213	71.8

package Text::Bloom;

use strict;

use Bit::Vector;

use FileHandle;

@Text::Bloom::hashParam = (
	[ 1,		0,	], #identity
	[ 48661,	109441 ],
	[ 13679,	103651 ],
	[ 41851,	33413 ],
	[ 69499,	2399 ],
	[ 55799,	85037 ],
	[ 127051,	73571 ],
	[ 7393,	60821 ],
	[ 123449,	100297 ],
	[ 124309,	87547 ],
	[ 67129,	5531 ],
	[ 72689,	44389 ],
);

BEGIN {
	$Text::Bloom::VERSION = '1.3';

	%Text::Bloom::Radix = ();
	@Text::Bloom::RadixDomain = ();
# previous value was too large for some linux boxes
#	$Text::Bloom::p = 4294967291;
	$Text::Bloom::p = 499979;
	%Text::Bloom::config = (
		d	=> 4,
		size 	=> 65536*2,
		compress=> 1,
	);

#	print __PACKAGE__ . ' v' . $Text::Bloom::VERSION . " ready\n";

	my @domain = 'a' .. 'z';
	push @domain, '0' .. '9';
	@Text::Bloom::RadixDomain = @domain;
	@Text::Bloom::Radix{ @domain } = 0 .. $#domain;
	eval {
		require Compress::Zlib;
	};
	if( $@ ){ $Text::Bloom::config{compress} = undef; }

}


sub new
{
	my $class= shift;
	my %self = @_;

	my $self = {};

	foreach my $key (qw( d size compress ) ){
		if( defined($self{$key}) ){
			$self->{$key} = $self{$key};
		} else {
			$self->{$key} = $Text::Bloom::config{$key};
		}
	}
	bless $self, $class;
	return $self;
}

sub Size
{
	my $self = shift;
	my ($newsize) = @_;
	$newsize and ($self->{size} = $newsize);
	return $self->{size};
}

sub Compute
{
	my $self = shift;
	my @terms = @_;

	my $bv = Bit::Vector->new( $self->{size} );

	foreach my $w (@terms) {
		my $q = $self->QuantizeV( $w );
		foreach my $i (1..$self->{d}){
			my $index = $self->HashV( $i-1, $q );
			if( 0 && $bv->bit_test($index) ){
				print STDOUT ("$w -> $q -> $index"
					. " COLLISION\n");
			}
			$bv->Bit_On( $index );
		}
	}

	my $nTerms = scalar @terms;
	my $nBits = $bv->Norm();

	if( $nBits > 0 ){
		$self->{collisionRatio} = 1.0 - $nBits/$nTerms/$self->{d};
	}

	print STDERR (
		$nTerms
		. ' terms added, bit vector norm is '
		. $nBits
		. ', collision ratio is '
		. $self->{collisionRatio}
		. "\n"
	) unless 1;
	return $self->{bv} = $bv;
}

sub QuantizeV
{
	my $self  = shift;
	my ($term) = @_;

	my @chars = split( //, $term );

	my $q = 0;
	for( my $i=$#chars; $i>=0; $i-- ){
		$q = $q * (scalar( @Text::Bloom::RadixDomain )+1)
			+ $Text::Bloom::Radix{ $chars[$i] } + 1;
		$q %= $Text::Bloom::p;
	}
	return $q;
}

sub HashV
{
	my $self =shift;
	my ($order,$x ) = @_;
	my ($m,$q) =  @{$Text::Bloom::hashParam[$order]};

	my $scrambled = $x * $m + $q;
	$scrambled %= $self->{size};

	return $scrambled;
}

sub WriteToString
{
	my $self = shift;

	return undef unless $self->{bv};

	my $block = $self->{bv}->Block_Read() ;
	if( $self->{compress} ){
		$block = Compress::Zlib::compress( $self->{bv}->Block_Read());
		$block or die(
			__PACKAGE__ . '::WriteToString : '
			. 'cannot compress block'
		);
	}

	my $str = 'p=' . __PACKAGE__
		. ' v='
		. $Text::Bloom::VERSION
		. ' size='
		. $self->{size}
		. ' d='
		. $self->{d}
		. ' compress='
		. ($self->{compress}?1:0)
		. ' l='
		. length( $block )
		. "\n" ;

	$str .= $block;

	$str .= pack( 'L', unpack( '%32C*', $str ));

	return $str;
}

sub WriteToFile
{
	my $self = shift;
	my ($file) = @_;

	my $f = FileHandle->new( '>'  . $file );
	binmode $f;

	$f->print( $self->WriteToString() );
}

sub NewFromString
{
	my ($string) = @_;

	my $self = {};

# verify checksum
	my $stored_checksum = substr( $string, -4 );
	$stored_checksum = unpack( 'L', $stored_checksum );
	$string = substr( $string, 0, -4 );
	my $computed_checksum = unpack( '%32C*', $string );

	if( $stored_checksum ne $computed_checksum ){
		die( __PACKAGE__ . '::NewFromString : '
			. 'checksum test failed '
			. $stored_checksum
			. ' != '
			. $computed_checksum
		);
	}

	# split in two: first line and rest
	my( $header, $block ) = split( /\n/, $string, 2 );


	# parse header line
	my %header = split( /[ 	=]+/, $header );

	# check that the reading package is the same as the one that wrote
	if( $header{p} ne __PACKAGE__ ){
		die( __PACKAGE__ . '::NewFromString : '
			. "file was not written by "
			. __PACKAGE__
			. ". Header is '$header'"
		);
	}

	# version must be identical
	if( $header{v} != $Text::Bloom::VERSION ){
		die( __PACKAGE__ . '::NewFromString : '
			. "Current version is $Text::Bloom::VERSION"
			. " and the file version is $header{v}"
		);
	}

	# size of block must match
	if( $header{l} != length( $block ) ){
		die( __PACKAGE__ . '::NewFromString : '
			. "data size is "
			. length( $block )
			. "instead of $header{l} "
		);
	}

	# retrieve header info
	@{$self}{ qw( size d compress ) } = @header{ qw( size d compress ) };

	# if we have to decompress, check that we have the required lib
	if( not( $Text::Bloom::config{compress} ) and ($header{compress}==1) ){
		die( __PACKAGE__ . '::NewFromString : '
			. 'file $file is compressed, but '
			. 'Compress::Zlib is not available.'
		);
	}

	if( $header{compress} ){
		eval {
			$block = Compress::Zlib::uncompress( $block );
		};
		($block and not($@)) or die(
			__PACKAGE__ . '::WriteToString : '
			. 'cannot uncompress block'
		);
	}

	$self->{bv} = Bit::Vector->new( $self->{size} );
	$self->{bv}->Block_Store( $block );

	bless $self, __PACKAGE__;

}

sub NewFromFile
{
	my ($file) = @_;

	my $f = FileHandle->new( $file );
	binmode $f;
	local $/ = undef;
	my $freezed = <$f>;

	return Text::Bloom::NewFromString( $freezed );
}

# similarity  is the  number of common bits
# divided by the number of all  nonzero bits
sub Similarity
{
	my $self = shift;
	my ($other) = @_;

	if( $self->{size} != $other->{size} ){
		die( __PACKAGE__ . '::Similarity : '
			. 'Bloom signatures cannot be compared '
			. "because sizes are $self->{size} and $other->{size}"
		);
	}

	my $union = Bit::Vector->new( $self->{size} );
	my $inter = Bit::Vector->new( $self->{size} );

	$union->Union( $self->{bv}, $other->{bv} );
	$inter->Intersection( $self->{bv}, $other->{bv} );

	my $normUnion = $union->Norm();
	($normUnion == 0) and  return 0;
	my $normInter = $inter->Norm();
	return $normInter / $normUnion;
}

sub GenerateHashes
{
	foreach (0..10){
		my $v = int( $Text::Bloom::config{size} * rand() );
		$v = Text::Bloom::GreatestPrimeLessThan( $v );

		my $vB = int( $Text::Bloom::config{size} * rand() );
		$vB = Text::Bloom::GreatestPrimeLessThan( $vB );

		print "[ $v,\t$vB ],\n";
	}
}

# very naive primality test

sub GreatestPrimeLessThan
{
	my ($number) = @_;

	while( not Text::Bloom::IsPrime( $number ) ){
		$number--;
	}
	return $number;
}

sub IsPrime
{
	my ($number) = @_;

	my $max = int( sqrt( $number ) );

	for( my $i = 2; $i <= $max ; $i++ ){
		if( $number % $i == 0 ){
#			print "$number is divisible by $i\n";
			return undef;
		}
	}

#	print "$number is prime\n";

	return 1;
}

1;

# this line was used to generate  hashParam
# Text::Bloom::GenerateHashes();

__END__