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


line stmt bran cond sub pod time code
1             package Text::Dice;
2              
3 2     2   33368 use strict;
  2         3  
  2         54  
4 2     2   6 use warnings;
  2         2  
  2         54  
5 2     2   6 use Exporter qw(import);
  2         10  
  2         641  
6              
7             our $VERSION = '0.06';
8             $VERSION = eval $VERSION;
9              
10             our @EXPORT = qw(coefficient);
11              
12             sub coefficient {
13 36 50   36 1 18459 return unless 2 == @_;
14              
15 36         65 my ($counts1, $counts2, $pairs1, $pairs2) = (0) x 2;
16 36 100 100     155 if (not ref $_[0] and not ref $_[1]) {
    100 66        
17 34         98 for my $w (split ' ', lc $_[0]) {
18 76         81 $counts1 += length($w) - 1;
19 76         1133 ++$pairs1->{substr $w, $_, 2} for (0 .. length($w) - 2);
20             }
21 34         97 for my $w (split ' ', lc $_[1]) {
22 208         183 $counts2 += length($w) - 1;
23 208         852 ++$pairs2->{substr $w, $_, 2} for (0 .. length($w) - 2);
24             }
25             }
26             elsif ('ARRAY' eq ref $_[0] and 'ARRAY' eq ref $_[1]) {
27 1         3 $counts1 += @{$_[0]};
  1         2  
28 1         1 ++$pairs1->{$_} for @{$_[0]};
  1         5  
29              
30 1         2 $counts2 += @{$_[1]};
  1         1  
31 1         1 ++$pairs2->{$_} for @{$_[1]};
  1         9  
32             }
33 1         6 else { return }
34              
35 35 50 33     138 return 0 unless $counts1 and $counts2;
36              
37 35 100       67 my ($smaller, $larger) = $counts1 > $counts2
38             ? ($pairs2, $pairs1) : ($pairs1, $pairs2);
39              
40 35         29 my $intersection = 0;
41 35         30 while (my ($pair, $count1) = each %{$smaller}) {
  464         804  
42 429 100       600 my $count2 = $larger->{$pair} or next;
43 315 100       409 $intersection += ($count2 > $count1) ? $count1 : $count2;
44             }
45              
46 35         495 return 2 * $intersection / ($counts1 + $counts2);
47             }
48              
49              
50             1;
51              
52             __END__