File Coverage

blib/lib/Text/TFIDF.pm
Criterion Covered Total %
statement 68 68 100.0
branch 11 14 78.5
condition 1 2 50.0
subroutine 11 11 100.0
pod 5 5 100.0
total 96 100 96.0


line stmt bran cond sub pod time code
1             package Text::TFIDF;
2              
3 1     1   56274 use 5.012003;
  1         3  
4 1     1   3 use strict;
  1         2  
  1         17  
5 1     1   4 use warnings;
  1         1  
  1         28  
6 1     1   5 use Carp;
  1         1  
  1         627  
7             require Encode;
8              
9             our $VERSION = '0.04';
10              
11              
12             sub new {
13 2     2 1 85 my $class = shift;
14 2         4 my $self = {};
15              
16 2         5 bless $self, $class;
17              
18 2         5 my %args = @_;
19              
20 2 100       8 if ($args{file}) {
21 1         2 $self->process_files(@{$args{file}});
  1         3  
22             }
23              
24 2         8 return $self;
25             }
26              
27             sub TFIDF {
28 5     5 1 539 my $self = shift;
29 5         6 my $file = shift;
30 5         7 my $word = shift;
31              
32 5 100       13 if (!defined $file) {
33 1         131 carp("You must give a filename for the TFIDF measure.\n");
34 1         131 return undef;
35             }
36              
37 4 100       8 if (!defined $word) {
38 1         58 carp("You must give a word for the TFIDF measure.\n");
39 1         93 return undef;
40             }
41              
42             # $word =~ s/[?;:!,.'"]//g;
43 3         8 $word =~ s/[?;:!,."\(\)]//g;
44 3 50       8 return undef if (!defined $self->{file}->{$file});
45 3         7 return $self->TF($file,$word)*$self->IDF($word);
46             }
47              
48              
49             sub TF {
50 4     4 1 7 my $self = shift;
51 4         6 my $file = shift;
52 4         5 my $word = shift;
53              
54 4         14 return $self->{file}->{$file}->{$word};
55             }
56              
57              
58             #IDF = log(number of documents/(number of documents containing the word))
59             sub IDF {
60              
61 4     4 1 7 my $self = shift;
62 4         7 my $word = shift;
63              
64 4         7 my $count = 0;
65              
66 4         5 foreach my $el (keys %{$self->{file}}) {
  4         13  
67 8 50       21 $count++ if (defined $self->{file}->{$el}->{$word});
68             }
69              
70 4         8 return log(scalar(keys %{$self->{file}})/($count))/log(10);
  4         33  
71             }
72              
73             sub process_files {
74              
75 2     2 1 733 my $self = shift;
76 2         4 my @documents = @_;
77              
78 2         5 foreach my $el (@documents) {
79 4         9 $self->_process_file($el);
80             }
81              
82 2         9 return 1;
83             }
84              
85             sub _process_file {
86 4     4   9 my $self = shift;
87 4         6 my $file = shift;
88              
89 4         6 my $hash;
90 4 50       80 return undef if (!-r $file);
91 1   50 1   8 open my $handle, '<:encoding(UTF-8)', $file || die $file," ",$!;
  1         2  
  1         7  
  4         169  
92 4         1437 while (<$handle>) {
93 138         292 chop;
94 138         315 my $line = lc($_);
95 138         704 my @words = split(/\s+/,$line);
96 138         285 foreach my $el (@words) {
97 1016         1922 $el =~ s/[?;:!,."\(\)]//g;
98 1016         1711 my $word = Encode::encode("utf8",$el);
99 1016 100       26149 if (defined $hash->{$word}) {
100 464         854 $hash->{$word}++;
101             }
102             else {
103 552         1426 $hash->{$word} = 1;
104             }
105             }
106             }
107 4         49 close($handle);
108            
109 4         30 $self->{file}->{$file} = $hash;
110              
111             }
112              
113             1;
114             __END__