line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Text::Dice; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
80113
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
85
|
|
4
|
2
|
|
|
2
|
|
12
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
66
|
|
5
|
2
|
|
|
2
|
|
3424
|
use parent qw(Exporter); |
|
2
|
|
|
|
|
1186
|
|
|
2
|
|
|
|
|
10
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
8
|
|
|
|
|
|
|
$VERSION = eval $VERSION; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
our @EXPORT = qw(coefficient); |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub coefficient { |
13
|
36
|
50
|
|
36
|
1
|
25730
|
return unless 2 == @_; |
14
|
|
|
|
|
|
|
|
15
|
36
|
|
|
|
|
84
|
my ($counts1, $counts2, $pairs1, $pairs2) = (0) x 2; |
16
|
36
|
100
|
100
|
|
|
193
|
if (not ref $_[0] and not ref $_[1]) { |
|
|
100
|
66
|
|
|
|
|
17
|
34
|
|
|
|
|
121
|
for my $w (split ' ', lc $_[0]) { |
18
|
76
|
|
|
|
|
207
|
$counts1 += length($w) - 1; |
19
|
76
|
|
|
|
|
691
|
++$pairs1->{substr $w, $_, 2} for (0 .. length($w) - 2); |
20
|
|
|
|
|
|
|
} |
21
|
34
|
|
|
|
|
137
|
for my $w (split ' ', lc $_[1]) { |
22
|
208
|
|
|
|
|
283
|
$counts2 += length($w) - 1; |
23
|
208
|
|
|
|
|
1980
|
++$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
|
|
|
|
|
3
|
++$pairs1->{$_} for @{$_[0]}; |
|
1
|
|
|
|
|
10
|
|
29
|
|
|
|
|
|
|
|
30
|
1
|
|
|
|
|
2
|
$counts2 += @{$_[1]}; |
|
1
|
|
|
|
|
3
|
|
31
|
1
|
|
|
|
|
3
|
++$pairs2->{$_} for @{$_[1]}; |
|
1
|
|
|
|
|
14
|
|
32
|
|
|
|
|
|
|
} |
33
|
1
|
|
|
|
|
6
|
else { return } |
34
|
|
|
|
|
|
|
|
35
|
35
|
50
|
33
|
|
|
178
|
return 0 unless $counts1 and $counts2; |
36
|
|
|
|
|
|
|
|
37
|
35
|
100
|
|
|
|
81
|
my ($smaller, $larger) = $counts1 > $counts2 |
38
|
|
|
|
|
|
|
? ($pairs2, $pairs1) : ($pairs1, $pairs2); |
39
|
|
|
|
|
|
|
|
40
|
35
|
|
|
|
|
40
|
my $intersection = 0; |
41
|
35
|
|
|
|
|
43
|
while (my ($pair, $count1) = each %{$smaller}) { |
|
464
|
|
|
|
|
1113
|
|
42
|
429
|
100
|
|
|
|
895
|
my $count2 = $larger->{$pair} or next; |
43
|
315
|
100
|
|
|
|
641
|
$intersection += ($count2 > $count1) ? $count1 : $count2; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
35
|
|
|
|
|
593
|
return 2 * $intersection / ($counts1 + $counts2); |
47
|
|
|
|
|
|
|
} |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
1; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
__END__ |