File Coverage

blib/lib/Set/Similarity/CosinePDL.pm
Criterion Covered Total %
statement 46 46 100.0
branch n/a
condition n/a
subroutine 10 10 100.0
pod 1 1 100.0
total 57 57 100.0


line stmt bran cond sub pod time code
1             package Set::Similarity::CosinePDL;
2              
3 1     1   831 use strict;
  1         2  
  1         38  
4 1     1   3 use warnings;
  1         2  
  1         30  
5              
6 1     1   622 use namespace::autoclean;
  1         16037  
  1         3  
7              
8 1     1   791 use PDL;
  1         9  
  1         5  
9              
10 1     1   195535 use parent 'Set::Similarity';
  1         1  
  1         8  
11              
12             our $VERSION = '0.013';
13              
14             sub from_sets {
15 21     21 1 10410 my ($self, $set1, $set2) = @_;
16 21         59 $self->_make_elem_list($set1,$set2);
17              
18 21         49 return $self->_cosine(
19             norm($self->_make_vector( $set1 )),
20             norm($self->_make_vector( $set2 ))
21             );
22             }
23              
24             sub _make_vector {
25 42     42   55 my ( $self, $tokens ) = @_;
26 42         68 my %elements = $self->_get_elements( $tokens );
27 42         135 my $vector = zeroes $self->{'elem_count'};
28            
29 42         2263 for my $key ( keys %elements ) {
30 122         1422 my $value = $elements{$key};
31 122         114 my $offset = $self->{'elem_index'}->{$key};
32 122         571 index( $vector, $offset ) .= $value;
33             }
34 42         1053 return $vector;
35             }
36              
37             sub _get_elements {
38 84     84   103 my ( $self, $tokens ) = @_;
39 84         82 my %elements;
40 84         217 do { $_++ } for @elements{@$tokens};
  244         333  
41 84         303 return %elements;
42             }
43              
44             sub _make_elem_list {
45 21     21   29 my ( $self,$tokens1,$tokens2 ) = @_;
46 21         25 my %all_elems;
47 21         42 for my $tokens ( $tokens1,$tokens2 ) {
48 42         82 my %elements = $self->_get_elements( $tokens );
49 42         115 for my $key ( keys %elements ) {
50 122         248 $all_elems{$key} += $elements{$key};
51             }
52             }
53            
54             # create a lookup hash
55 21         24 my %lookup;
56 21         121 my @sorted_elems = sort keys %all_elems;
57 21         107 @lookup{@sorted_elems} = (0..scalar(@sorted_elems)-1 );
58            
59 21         52 $self->{'elem_index'} = \%lookup;
60 21         57 $self->{'elem_list'} = \@sorted_elems;
61 21         100 $self->{'elem_count'} = scalar @sorted_elems;
62             }
63              
64             # Assumes both incoming vectors are normalized
65             sub _cosine {
66 21     21   23 my ( $self, $vec1, $vec2 ) = @_;
67 21         143 my $cos = inner( $vec1, $vec2 ); # inner product
68 21         62 return $cos->sclr(); # converts PDL object to Perl scalar
69             }
70              
71             1;
72              
73              
74             __END__