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


line stmt bran cond sub pod time code
1            
2             package Text::Bloom;
3            
4 1     1   655 use strict;
  1         1  
  1         37  
5            
6 1     1   954 use Bit::Vector;
  1         3547  
  1         73  
7            
8 1     1   1047 use FileHandle;
  1         13753  
  1         7  
9            
10             @Text::Bloom::hashParam = (
11             [ 1, 0, ], #identity
12             [ 48661, 109441 ],
13             [ 13679, 103651 ],
14             [ 41851, 33413 ],
15             [ 69499, 2399 ],
16             [ 55799, 85037 ],
17             [ 127051, 73571 ],
18             [ 7393, 60821 ],
19             [ 123449, 100297 ],
20             [ 124309, 87547 ],
21             [ 67129, 5531 ],
22             [ 72689, 44389 ],
23             );
24            
25             BEGIN {
26 1     1   560 $Text::Bloom::VERSION = '1.3';
27            
28 1         2 %Text::Bloom::Radix = ();
29 1         2 @Text::Bloom::RadixDomain = ();
30             # previous value was too large for some linux boxes
31             # $Text::Bloom::p = 4294967291;
32 1         2 $Text::Bloom::p = 499979;
33 1         4 %Text::Bloom::config = (
34             d => 4,
35             size => 65536*2,
36             compress=> 1,
37             );
38            
39             # print __PACKAGE__ . ' v' . $Text::Bloom::VERSION . " ready\n";
40            
41 1         7 my @domain = 'a' .. 'z';
42 1         16 push @domain, '0' .. '9';
43 1         15 @Text::Bloom::RadixDomain = @domain;
44 1         33 @Text::Bloom::Radix{ @domain } = 0 .. $#domain;
45 1         4 eval {
46 1         4867 require Compress::Zlib;
47             };
48 1 50       82065 if( $@ ){ $Text::Bloom::config{compress} = undef; }
  0         0  
49            
50             }
51            
52            
53             sub new
54             {
55 3     3 1 57 my $class= shift;
56 3         8 my %self = @_;
57            
58 3         5 my $self = {};
59            
60 3         8 foreach my $key (qw( d size compress ) ){
61 9 50       19 if( defined($self{$key}) ){
62 0         0 $self->{$key} = $self{$key};
63             } else {
64 9         22 $self->{$key} = $Text::Bloom::config{$key};
65             }
66             }
67 3         8 bless $self, $class;
68 3         9 return $self;
69             }
70            
71             sub Size
72             {
73 0     0 1 0 my $self = shift;
74 0         0 my ($newsize) = @_;
75 0 0       0 $newsize and ($self->{size} = $newsize);
76 0         0 return $self->{size};
77             }
78            
79             sub Compute
80             {
81 3     3 1 15 my $self = shift;
82 3         9 my @terms = @_;
83            
84 3         59 my $bv = Bit::Vector->new( $self->{size} );
85            
86 3         6 foreach my $w (@terms) {
87 12         27 my $q = $self->QuantizeV( $w );
88 12         24 foreach my $i (1..$self->{d}){
89 48         97 my $index = $self->HashV( $i-1, $q );
90 48         35 if( 0 && $bv->bit_test($index) ){
91             print STDOUT ("$w -> $q -> $index"
92             . " COLLISION\n");
93             }
94 48         133 $bv->Bit_On( $index );
95             }
96             }
97            
98 3         5 my $nTerms = scalar @terms;
99 3         61 my $nBits = $bv->Norm();
100            
101 3 50       7 if( $nBits > 0 ){
102 3         11 $self->{collisionRatio} = 1.0 - $nBits/$nTerms/$self->{d};
103             }
104            
105 3         3 print STDERR (
106             $nTerms
107             . ' terms added, bit vector norm is '
108             . $nBits
109             . ', collision ratio is '
110             . $self->{collisionRatio}
111             . "\n"
112             ) unless 1;
113 3         13 return $self->{bv} = $bv;
114             }
115            
116             sub QuantizeV
117             {
118 12     12 1 13 my $self = shift;
119 12         13 my ($term) = @_;
120            
121 12         43 my @chars = split( //, $term );
122            
123 12         15 my $q = 0;
124 12         28 for( my $i=$#chars; $i>=0; $i-- ){
125 74         104 $q = $q * (scalar( @Text::Bloom::RadixDomain )+1)
126             + $Text::Bloom::Radix{ $chars[$i] } + 1;
127 74         119 $q %= $Text::Bloom::p;
128             }
129 12         25 return $q;
130             }
131            
132             sub HashV
133             {
134 48     48 1 46 my $self =shift;
135 48         46 my ($order,$x ) = @_;
136 48         30 my ($m,$q) = @{$Text::Bloom::hashParam[$order]};
  48         70  
137            
138 48         46 my $scrambled = $x * $m + $q;
139 48         167 $scrambled %= $self->{size};
140            
141 48         63 return $scrambled;
142             }
143            
144             sub WriteToString
145             {
146 2     2 1 9 my $self = shift;
147            
148 2 50       18 return undef unless $self->{bv};
149            
150 2         92 my $block = $self->{bv}->Block_Read() ;
151 2 50       6 if( $self->{compress} ){
152 2         132 $block = Compress::Zlib::compress( $self->{bv}->Block_Read());
153 2 50       2235 $block or die(
154             __PACKAGE__ . '::WriteToString : '
155             . 'cannot compress block'
156             );
157             }
158            
159 2 50       21 my $str = 'p=' . __PACKAGE__
160             . ' v='
161             . $Text::Bloom::VERSION
162             . ' size='
163             . $self->{size}
164             . ' d='
165             . $self->{d}
166             . ' compress='
167             . ($self->{compress}?1:0)
168             . ' l='
169             . length( $block )
170             . "\n" ;
171            
172 2         5 $str .= $block;
173            
174 2         18 $str .= pack( 'L', unpack( '%32C*', $str ));
175            
176 2         12 return $str;
177             }
178            
179             sub WriteToFile
180             {
181 1     1 1 9 my $self = shift;
182 1         1 my ($file) = @_;
183            
184 1         14 my $f = FileHandle->new( '>' . $file );
185 1         409 binmode $f;
186            
187 1         4 $f->print( $self->WriteToString() );
188             }
189            
190             sub NewFromString
191             {
192 2     2 1 8 my ($string) = @_;
193            
194 2         4 my $self = {};
195            
196             # verify checksum
197 2         6 my $stored_checksum = substr( $string, -4 );
198 2         6 $stored_checksum = unpack( 'L', $stored_checksum );
199 2         2 $string = substr( $string, 0, -4 );
200 2         8 my $computed_checksum = unpack( '%32C*', $string );
201            
202 2 50       9 if( $stored_checksum ne $computed_checksum ){
203 0         0 die( __PACKAGE__ . '::NewFromString : '
204             . 'checksum test failed '
205             . $stored_checksum
206             . ' != '
207             . $computed_checksum
208             );
209             }
210            
211             # split in two: first line and rest
212 2         12 my( $header, $block ) = split( /\n/, $string, 2 );
213            
214            
215             # parse header line
216 2         29 my %header = split( /[ =]+/, $header );
217            
218             # check that the reading package is the same as the one that wrote
219 2 50       9 if( $header{p} ne __PACKAGE__ ){
220 0         0 die( __PACKAGE__ . '::NewFromString : '
221             . "file was not written by "
222             . __PACKAGE__
223             . ". Header is '$header'"
224             );
225             }
226            
227             # version must be identical
228 2 50       11 if( $header{v} != $Text::Bloom::VERSION ){
229 0         0 die( __PACKAGE__ . '::NewFromString : '
230             . "Current version is $Text::Bloom::VERSION"
231             . " and the file version is $header{v}"
232             );
233             }
234            
235             # size of block must match
236 2 50       8 if( $header{l} != length( $block ) ){
237 0         0 die( __PACKAGE__ . '::NewFromString : '
238             . "data size is "
239             . length( $block )
240             . "instead of $header{l} "
241             );
242             }
243            
244             # retrieve header info
245 2         6 @{$self}{ qw( size d compress ) } = @header{ qw( size d compress ) };
  2         8  
246            
247             # if we have to decompress, check that we have the required lib
248 2 50 33     9 if( not( $Text::Bloom::config{compress} ) and ($header{compress}==1) ){
249 0         0 die( __PACKAGE__ . '::NewFromString : '
250             . 'file $file is compressed, but '
251             . 'Compress::Zlib is not available.'
252             );
253             }
254            
255 2 50       5 if( $header{compress} ){
256 2         4 eval {
257 2         7 $block = Compress::Zlib::uncompress( $block );
258             };
259 2 50 33     338 ($block and not($@)) or die(
260             __PACKAGE__ . '::WriteToString : '
261             . 'cannot uncompress block'
262             );
263             }
264            
265 2         25 $self->{bv} = Bit::Vector->new( $self->{size} );
266 2         76 $self->{bv}->Block_Store( $block );
267            
268 2         25 bless $self, __PACKAGE__;
269            
270             }
271            
272             sub NewFromFile
273             {
274 1     1 1 90 my ($file) = @_;
275            
276 1         6 my $f = FileHandle->new( $file );
277 1         76 binmode $f;
278 1         6 local $/ = undef;
279 1         23 my $freezed = <$f>;
280            
281 1         3 return Text::Bloom::NewFromString( $freezed );
282             }
283            
284             # similarity is the number of common bits
285             # divided by the number of all nonzero bits
286             sub Similarity
287             {
288 5     5 0 122 my $self = shift;
289 5         14 my ($other) = @_;
290            
291 5 50       24 if( $self->{size} != $other->{size} ){
292 0         0 die( __PACKAGE__ . '::Similarity : '
293             . 'Bloom signatures cannot be compared '
294             . "because sizes are $self->{size} and $other->{size}"
295             );
296             }
297            
298 5         79 my $union = Bit::Vector->new( $self->{size} );
299 5         121 my $inter = Bit::Vector->new( $self->{size} );
300            
301 5         57 $union->Union( $self->{bv}, $other->{bv} );
302 5         52 $inter->Intersection( $self->{bv}, $other->{bv} );
303            
304 5         78 my $normUnion = $union->Norm();
305 5 50       12 ($normUnion == 0) and return 0;
306 5         97 my $normInter = $inter->Norm();
307 5         42 return $normInter / $normUnion;
308             }
309            
310             sub GenerateHashes
311             {
312 0     0 0   foreach (0..10){
313 0           my $v = int( $Text::Bloom::config{size} * rand() );
314 0           $v = Text::Bloom::GreatestPrimeLessThan( $v );
315            
316 0           my $vB = int( $Text::Bloom::config{size} * rand() );
317 0           $vB = Text::Bloom::GreatestPrimeLessThan( $vB );
318            
319 0           print "[ $v,\t$vB ],\n";
320             }
321             }
322            
323             # very naive primality test
324            
325             sub GreatestPrimeLessThan
326             {
327 0     0 0   my ($number) = @_;
328            
329 0           while( not Text::Bloom::IsPrime( $number ) ){
330 0           $number--;
331             }
332 0           return $number;
333             }
334            
335             sub IsPrime
336             {
337 0     0 0   my ($number) = @_;
338            
339 0           my $max = int( sqrt( $number ) );
340            
341 0           for( my $i = 2; $i <= $max ; $i++ ){
342 0 0         if( $number % $i == 0 ){
343             # print "$number is divisible by $i\n";
344 0           return undef;
345             }
346             }
347            
348             # print "$number is prime\n";
349            
350 0           return 1;
351             }
352            
353             1;
354            
355             # this line was used to generate hashParam
356             # Text::Bloom::GenerateHashes();
357            
358             __END__