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   803 use strict;
  1         3  
  1         32  
4 1     1   5 use warnings;
  1         3  
  1         25  
5              
6 1     1   501 use namespace::autoclean;
  1         18444  
  1         5  
7              
8 1     1   801 use PDL;
  1         15  
  1         8  
9              
10 1     1   225719 use parent 'Set::Similarity';
  1         2  
  1         8  
11              
12             our $VERSION = '0.014';
13              
14             sub from_sets {
15 21     21 1 15557 my ($self, $set1, $set2) = @_;
16 21         61 $self->_make_elem_list($set1,$set2);
17              
18 21         53 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   90 my ( $self, $tokens ) = @_;
26 42         74 my %elements = $self->_get_elements( $tokens );
27 42         133 my $vector = zeroes $self->{'elem_count'};
28              
29 42         2654 for my $key ( keys %elements ) {
30 122         1876 my $value = $elements{$key};
31 122         180 my $offset = $self->{'elem_index'}->{$key};
32 122         648 index( $vector, $offset ) .= $value;
33             }
34 42         1292 return $vector;
35             }
36              
37             sub _get_elements {
38 84     84   142 my ( $self, $tokens ) = @_;
39 84         111 my %elements;
40 84         191 do { $_++ } for @elements{@$tokens};
  244         369  
41 84         272 return %elements;
42             }
43              
44             sub _make_elem_list {
45 21     21   36 my ( $self,$tokens1,$tokens2 ) = @_;
46 21         32 my %all_elems;
47 21         45 for my $tokens ( $tokens1,$tokens2 ) {
48 42         81 my %elements = $self->_get_elements( $tokens );
49 42         98 for my $key ( keys %elements ) {
50 122         267 $all_elems{$key} += $elements{$key};
51             }
52             }
53              
54             # create a lookup hash
55 21         32 my %lookup;
56 21         101 my @sorted_elems = sort keys %all_elems;
57 21         81 @lookup{@sorted_elems} = (0..scalar(@sorted_elems)-1 );
58              
59 21         67 $self->{'elem_index'} = \%lookup;
60 21         45 $self->{'elem_list'} = \@sorted_elems;
61 21         51 $self->{'elem_count'} = scalar @sorted_elems;
62             }
63              
64             # Assumes both incoming vectors are normalized
65             sub _cosine {
66 21     21   65 my ( $self, $vec1, $vec2 ) = @_;
67 21         160 my $cos = inner( $vec1, $vec2 ); # inner product
68 21         71 return $cos->sclr(); # converts PDL object to Perl scalar
69             }
70              
71             1;
72              
73              
74             __END__