File Coverage

blib/lib/Bag/Similarity/Cosine.pm
Criterion Covered Total %
statement 41 41 100.0
branch 2 2 100.0
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 54 54 100.0


line stmt bran cond sub pod time code
1             package Bag::Similarity::Cosine;
2              
3 1     1   648 use strict;
  1         1  
  1         31  
4 1     1   4 use warnings;
  1         1  
  1         37  
5              
6 1     1   488 use parent 'Bag::Similarity';
  1         284  
  1         6  
7              
8             our $VERSION = '0.021';
9              
10             sub from_bags {
11 22     22 1 32 my ($self, $bag1, $bag2) = @_;
12              
13 22         33 my $cosine = $self->_cosine(
14             $self->_normalize($self->_make_vector( $bag1 )),
15             $self->_normalize($self->_make_vector( $bag2 ))
16             );
17 22         131 return $cosine;
18             }
19              
20             sub _make_vector {
21 44     44   42 my ( $self, $tokens ) = @_;
22 44         34 my %elements;
23 44         134 do { $_++ } for @elements{@$tokens};
  150         157  
24 44         79 return \%elements;
25             }
26              
27             # Assumes both incoming vectors are normalized
28 22     22   39 sub _cosine { shift->_dot( @_ ) }
29              
30             sub _norm {
31 44     44   33 my $self = shift;
32 44         34 my $vector = shift;
33 44         35 my $sum = 0;
34 44         106 for my $key (keys %$vector) {
35 126         156 $sum += $vector->{$key} ** 2;
36             }
37 44         107 return sqrt $sum;
38             }
39              
40             sub _normalize {
41 44     44   40 my $self = shift;
42 44         33 my $vector = shift;
43              
44 44         53 return $self->_div(
45             $vector,
46             $self->_norm($vector)
47             );
48             }
49              
50             sub _dot {
51 22     22   18 my $self = shift;
52 22         16 my $vector1 = shift;
53 22         18 my $vector2 = shift;
54              
55 22         16 my $dotprod = 0;
56              
57 22         38 for my $key (keys %$vector1) {
58 66 100       133 $dotprod += $vector1->{$key} * $vector2->{$key} if ($vector2->{$key});
59             }
60 22         38 return $dotprod;
61             }
62              
63              
64             # divides each vector entry by a given divisor
65             sub _div {
66 44     44   54 my $self = shift;
67 44         34 my $vector = shift;
68 44         63 my $divisor = shift;
69              
70 44         44 my $vector2 = {};
71 44         64 for my $key (keys %$vector) {
72 126         179 $vector2->{$key} = $vector->{$key} / $divisor;
73             }
74 44         91 return $vector2;
75             }
76              
77              
78             1;
79              
80              
81             __END__