File Coverage

blib/lib/Text/Dice.pm

Criterion	Covered	Total	%
statement	35	35	100.0
branch	12	14	85.7
condition	6	9	66.6
subroutine	4	4	100.0
pod	1	1	100.0
total	58	63	92.0

package Text::Dice;

use strict;
use warnings;
use Exporter qw(import);

our $VERSION = '0.06';
$VERSION = eval $VERSION;

our @EXPORT = qw(coefficient);

sub coefficient {
    return unless 2 == @_;

    my ($counts1, $counts2, $pairs1, $pairs2) = (0) x 2;
    if (not ref $_[0] and not ref $_[1]) {
        for my $w (split ' ', lc $_[0]) {
            $counts1 += length($w) - 1;
            ++$pairs1->{substr $w, $_, 2} for (0 .. length($w) - 2);
        }
        for my $w (split ' ', lc $_[1]) {
            $counts2 += length($w) - 1;
            ++$pairs2->{substr $w, $_, 2} for (0 .. length($w) - 2);
        }
    }
    elsif ('ARRAY' eq ref $_[0] and 'ARRAY' eq ref $_[1]) {
        $counts1 +=  @{$_[0]};
        ++$pairs1->{$_} for @{$_[0]};

        $counts2 +=  @{$_[1]};
        ++$pairs2->{$_} for @{$_[1]};
    }
    else { return }

    return 0 unless $counts1 and $counts2;

    my ($smaller, $larger) = $counts1 > $counts2
        ? ($pairs2, $pairs1) : ($pairs1, $pairs2);

    my $intersection = 0;
    while (my ($pair, $count1) = each %{$smaller}) {
        my $count2 = $larger->{$pair} or next;
        $intersection += ($count2 > $count1) ? $count1 : $count2;
    }

    return 2 * $intersection / ($counts1 + $counts2);
}


1;

__END__