File Coverage

blib/lib/Bag/Similarity.pm

Criterion	Covered	Total	%
statement	54	54	100.0
branch	24	24	100.0
condition	11	12	100.0
subroutine	13	13	100.0
pod	8	8	100.0
total	110	111	100.0

package Bag::Similarity;

use strict;
use warnings;

use 5.008_005;
our $VERSION = '0.020';

use Carp 'croak';

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

sub similarity {
  my ($self, $any1, $any2, $width) = @_;

  return $self->from_tokens(
    $self->_any($any1,$width),
    $self->_any($any2,$width)
  );
}

sub _any {
  my ($self, $any, $width) = @_;

  if (ref($any) eq 'ARRAY') {
    return $any;
  }
  elsif (ref($any) eq 'HASH') {
    return [grep { $any->{$_} } keys %$any];
  }
  elsif (ref($any)) {
    return [];
  }
  else {
    return [$self->ngrams($any,$width)];
  }
}

sub ngrams {
  my ($self, $word, $width) = @_;

  $width = 1 unless ($width && $width =~ m/^[1-9][0-9]*$/x);
  $word ||= '';

  return ($word) unless ($width <= length($word));

  return map {substr $word,$_,$width;} (0..length($word)-$width);
}

sub from_tokens {
  my ($self, $tokens1, $tokens2) = @_;

  return 1 if (!(scalar @$tokens1 || scalar @$tokens2));
  return 0 unless (scalar @$tokens1 && scalar @$tokens2 );

  return $self->from_bags(
    $tokens1,
    $tokens2,
  );
}

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

sub intersection {
  my ($self, $tokens1, $tokens2) = @_;
  my %bag1;
  my %bag2;
  $bag1{$_}++ for @{$tokens1};
  $bag2{$_}++ for @{$tokens2};
  my $intersection = 0;
  for (keys %bag1) {
    next unless (exists $bag2{$_} );
    $intersection += ( $bag2{$_} < $bag1{$_}) ? $bag2{$_} : $bag1{$_};
  }
  return $intersection;
}

sub combined_length {
  scalar(@{$_[1]}) + scalar(@{$_[2]});
}

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

1;

__END__