File Coverage

blib/lib/Set/Similarity/BV.pm

Criterion	Covered	Total	%
statement	64	64	100.0
branch	10	10	100.0
condition	10	12	91.6
subroutine	17	17	100.0
pod	7	7	100.0
total	108	110	99.0

package Set::Similarity::BV;

use strict;
use warnings;

our $VERSION = '0.06';

use Carp 'croak';


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

# https://graphics.stanford.edu/~seander/bithacks.html#CountBitsSetParallel
our $final_shift = (($width/8) - 1) * 8;
no warnings 'portable'; # for 0xffffffffffffffff
our $x01 = hex(substr('01'x16,0,$chunk_size));
our $x33 = hex(substr('33'x16,0,$chunk_size));
our $x55 = hex(substr('55'x16,0,$chunk_size));
our $x0f = hex(substr('0f'x16,0,$chunk_size));


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 @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

  my $bits = 0;

    for my $i (@{$array_of_integers}) {
      my $v = $i; # don't use (and change) $i directly
      $v = $v - (($v >> 1) & $x55);
      $v = ($v & $x33) + (($v >> 2) & $x33);
      # (bytesof($v) -1) * bitsofbyte = (8-1)*8 = --vvvvvvv
      $v = (($v + ($v >> 4) & $x0f) * $x01) >> $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__