File Coverage

blib/lib/Set/Similarity/BV.pm

Criterion	Covered	Total	%
statement	66	66	100.0
branch	10	10	100.0
condition	10	12	91.6
subroutine	17	17	100.0
pod	7	7	100.0
total	110	112	99.1

package Set::Similarity::BV;

use strict;
use warnings;

our $VERSION = '0.05';

use Carp 'croak';
use Data::Dumper;

our $width = int 0.999+log(~0)/log(2);

sub new {
  my $class = shift;

  # uncoverable condition false
  bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class;
}

sub similarity {
  my ($self, $hex1, $hex2) = @_;

  return 1 if (!($hex1 || $hex2));    # both zero
  return 0 unless ($hex1 && $hex2);   # one is zero

  #return 1 if (!(hex($hex1) || hex($hex2)));    # both zero
  #return 0 unless (hex($hex1) && hex($hex2) ); # one is zero

  no warnings 'portable'; # for 0xffffffffffffffff

  return $self->from_integers(
    $self->_integers($hex1),
    $self->_integers($hex2),
  );
}


sub from_integers { croak 'Method "from_integers" not implemented in subclass' }

sub intersection {
  my ($self,$v1,$v2) = @_;

  no warnings 'portable'; # for 0xffffffffffffffff

  my $bits = 0;
  my $max1 = scalar(@{$v1}) - 1;
  my $max2 = scalar(@{$v2}) - 1;

  for (my $i=0; ($i <= $max1) && ($i <= $max2); $i++) {
    $bits += $self->bits([ ($v1->[$i] & $v2->[$i]) ]);
  }
  return $bits;
}

sub _integers {
  my ($self,$hex_string) = @_;

  my $chunk_size = int($width/4);
  my @chunks = $hex_string =~ m/([0-9a-f]{1,$chunk_size})/gi;

  no warnings 'portable'; # for 0xffffffffffffffff
  my $result = [];
  for my $chunk (@chunks) {
    push @{$result},hex($chunk);
  }
  return $result;
}

sub bits {
  my ($self,$array_of_integers) = @_;

  use integer;
  no warnings 'portable'; # for 0xffffffffffffffff

  # (bytesof($v) -1) * bitsofbyte = (8-1)*8 = 56 # for 64 bit
  # (bytesof($v) -1) * bitsofbyte = (8-1)*8 = 56 # for 32 bit
  my $final_shift = (($width/8) - 1) * 8;

  my $bits = 0;
  for my $i (@{$array_of_integers}) {
    my $v = $i; # don't use (and change) $i directly
    $v = $v - (($v >> 1) & 0x5555555555555555);
    $v = ($v & 0x3333333333333333) + (($v >> 2) & 0x3333333333333333);
    # (bytesof($v) -1) * bitsofbyte = (8-1)*8 = 56 ----------------------vv
    $v = (($v + ($v >> 4) & 0x0f0f0f0f0f0f0f0f) * 0x0101010101010101) >> $final_shift;
    $bits += $v;
  }

  return $bits;
}

sub combined_length {
  my ($self,$v1,$v2) = @_;

  return $self->bits($v1) + $self->bits($v2);
}

sub min {
  ($_[1] < $_[2])
    ? $_[1] : $_[2];
}

1;

__END__