File Coverage

blib/lib/Lingua/EN/Opinion.pm
Criterion Covered Total %
statement 119 133 89.4
branch 23 30 76.6
condition 1 2 50.0
subroutine 24 29 82.7
pod 13 13 100.0
total 180 207 86.9


line stmt bran cond sub pod time code
1             package Lingua::EN::Opinion;
2             our $AUTHORITY = 'cpan:GENE';
3              
4             # ABSTRACT: Measure the emotional sentiment of text
5              
6             our $VERSION = '0.1701';
7              
8 1     1   1572 use Moo;
  1         12343  
  1         6  
9 1     1   2057 use strictures 2;
  1         1723  
  1         40  
10 1     1   754 use namespace::clean;
  1         12449  
  1         16  
11              
12 1     1   1075 use Lingua::EN::Opinion::Positive;
  1         3  
  1         35  
13 1     1   930 use Lingua::EN::Opinion::Negative;
  1         2  
  1         33  
14 1     1   8667 use Lingua::EN::Opinion::Emotion;
  1         3  
  1         56  
15              
16 1     1   10 use Carp;
  1         2  
  1         92  
17 1     1   697 use File::Slurper qw( read_text );
  1         14770  
  1         92  
18 1     1   545 use Lingua::EN::Sentence qw( get_sentences );
  1         14785  
  1         68  
19 1     1   593 use Statistics::Lite qw( mean );
  1         1600  
  1         64  
20 1     1   8 use Try::Tiny;
  1         2  
  1         1843  
21              
22              
23             has file => (
24             is => 'ro',
25             isa => sub { die "File $_[0] does not exist" unless -e $_[0] },
26             );
27              
28              
29             has text => (
30             is => 'ro',
31             );
32              
33              
34             has stem => (
35             is => 'ro',
36             default => sub { 0 },
37             );
38              
39              
40             has stemmer => (
41             is => 'ro',
42             lazy => 1,
43             builder => 1,
44             init_arg => undef,
45             );
46              
47             sub _build_stemmer {
48             try {
49 0     0   0 require WordNet::QueryData;
50 0         0 require WordNet::stem;
51              
52 0         0 my $wn = WordNet::QueryData->new();
53 0         0 my $stemmer = WordNet::stem->new($wn);
54              
55 0         0 return $stemmer;
56             }
57             catch {
58 0     0   0 croak 'The WordNet::QueryData and WordNet::stem modules must be installed and working to enable stemming support';
59 0     0   0 };
60             }
61              
62              
63             has sentences => (
64             is => 'rw',
65             init_arg => undef,
66             default => sub { [] },
67             );
68              
69              
70             has scores => (
71             is => 'rw',
72             init_arg => undef,
73             default => sub { [] },
74             );
75              
76              
77             has nrc_scores => (
78             is => 'rw',
79             init_arg => undef,
80             default => sub { [] },
81             );
82              
83              
84             has positive => (
85             is => 'ro',
86             init_arg => undef,
87             default => sub { Lingua::EN::Opinion::Positive->new },
88             );
89              
90              
91             has negative => (
92             is => 'ro',
93             init_arg => undef,
94             default => sub { Lingua::EN::Opinion::Negative->new },
95             );
96              
97              
98             has emotion => (
99             is => 'ro',
100             init_arg => undef,
101             default => sub { Lingua::EN::Opinion::Emotion->new },
102             );
103              
104              
105             has familiarity => (
106             is => 'rw',
107             init_arg => undef,
108             default => sub { { known => 0, unknown => 0 } },
109             );
110              
111              
112             sub analyze {
113 2     2 1 47518 my ($self) = @_;
114              
115 2         5 my @scores;
116 2         6 my ( $known, $unknown ) = ( 0, 0 );
117              
118 2         10 for my $sentence ( $self->_get_sentences ) {
119 22         30 my $score = 0;
120 22         48 ( $score, $known, $unknown ) = $self->get_sentence( $sentence, $known, $unknown );
121 22         49 push @scores, $score;
122             }
123              
124 2         19 $self->familiarity( { known => $known, unknown => $unknown } );
125              
126 2         12 $self->scores( \@scores );
127             }
128              
129              
130 1     1 1 6 sub averaged_score { shift->averaged_scores(@_) }
131              
132             sub averaged_scores {
133 1     1 1 4 my ( $self, $bins ) = @_;
134              
135 1   50     5 $bins ||= 10;
136              
137 1         3 my @scores = map { $_ } @{ $self->scores };
  11         19  
  1         4  
138              
139 1         2 my @averaged;
140              
141 1         6 while ( my @n = splice @scores, 0, $bins ) {
142 6         150 push @averaged, mean(@n);
143             }
144              
145 1         14 return \@averaged;
146             }
147              
148              
149 0     0 1 0 sub nrc_sentiment { shift->nrc_analyze(@_) };
150              
151             sub nrc_analyze {
152 1     1 1 596 my ($self) = @_;
153              
154 1         4 my $null_state = { map { $_ => 0 } qw/ anger anticipation disgust fear joy negative positive sadness surprise trust / };
  10         48  
155              
156 1         3 my @scores;
157 1         14 my ( $known, $unknown ) = ( 0, 0 );
158              
159 1         4 for my $sentence ( $self->_get_sentences ) {
160 11         19 my $score = {};
161              
162 11         28 ( $score, $known, $unknown ) = $self->nrc_get_sentence( $sentence, $known, $unknown );
163              
164 11 50       27 $score = $null_state
165             unless $score;
166              
167 11         23 push @scores, $score;
168             }
169              
170 1         10 $self->familiarity( { known => $known, unknown => $unknown } );
171              
172 1         8 $self->nrc_scores( \@scores );
173             }
174              
175              
176             sub get_word {
177 199     199 1 1924 my ( $self, $word ) = @_;
178              
179 199 50       405 $word = $self->_stemword($word)
180             if $self->stem;
181              
182             return exists $self->positive->wordlist->{$word} ? 1
183 199 100       738 : exists $self->negative->wordlist->{$word} ? -1
    100          
184             : undef;
185             }
186              
187              
188             sub set_word {
189 1     1 1 4 my ( $self, $word, $value ) = @_;
190              
191 1 50       6 if ($value > 0) {
192 1         8 $self->positive->wordlist->{$word} = $value;
193             }
194             else {
195 0         0 $self->negative->wordlist->{$word} = $value;
196             }
197             }
198              
199              
200             sub nrc_get_word {
201 102     102 1 3364 my ( $self, $word ) = @_;
202              
203 102 50       215 $word = $self->_stemword($word)
204             if $self->stem;
205              
206             return exists $self->emotion->wordlist->{$word}
207 102 100       335 ? $self->emotion->wordlist->{$word}
208             : undef;
209             }
210              
211              
212             sub nrc_set_word {
213 1     1 1 396 my ( $self, $word, $value ) = @_;
214              
215 1         3 my %emotion;
216              
217 1         3 for my $emotion (qw(
218             anger
219             anticipation
220             disgust
221             fear
222             joy
223             negative
224             positive
225             sadness
226             surprise
227             trust
228             )) {
229 10 50       22 if (exists $value->{$emotion}) {
230 10         18 $emotion{$emotion} = $value->{$emotion};
231             }
232             else {
233 0         0 $emotion{$emotion} = 0;
234             }
235             }
236              
237 1         8 $self->emotion->wordlist->{$word} = \%emotion;
238             }
239              
240              
241             sub get_sentence {
242 24     24 1 719 my ( $self, $sentence, $known, $unknown ) = @_;
243              
244 24         46 my @words = $self->tokenize($sentence);
245              
246 24         39 my $score = 0;
247              
248 24         43 for my $word ( @words ) {
249 194         312 my $value = $self->get_word($word);
250 194 100       333 if ( $value ) {
251 25         33 $known++;
252             }
253             else {
254 169         208 $unknown++;
255             }
256              
257 194 100       431 $score += $value
258             if defined $value;
259             }
260              
261 24         66 return $score, $known, $unknown;
262             }
263              
264              
265             sub nrc_get_sentence {
266 12     12 1 1631 my ( $self, $sentence, $known, $unknown ) = @_;
267              
268 12         26 my @words = $self->tokenize($sentence);
269              
270 12         22 my $score = {};
271              
272 12         22 for my $word ( @words ) {
273 97         191 my $value = $self->nrc_get_word($word);
274              
275 97 100       152 if ( $value ) {
276 30         40 $known++;
277              
278 30         166 for my $key ( keys %$value ) {
279 300         497 $score->{$key} += $value->{$key};
280             }
281             }
282             else {
283 67         94 $unknown++;
284             }
285             }
286              
287 12         28 return $score, $known, $unknown;
288             }
289              
290              
291             sub ratio {
292 7     7 1 11614 my ( $self, $flag ) = @_;
293              
294 7 100       36 my $numerator = $flag ? $self->familiarity->{unknown} : $self->familiarity->{known};
295              
296 7         36 my $ratio = $numerator / ( $self->familiarity->{known} + $self->familiarity->{unknown} );
297              
298 6         69 return $ratio;
299             }
300              
301              
302             sub tokenize {
303 36     36 1 68 my ( $self, $sentence ) = @_;
304 36         157 $sentence =~ s/[[:punct:]]//g; # Drop punctuation
305 36         75 $sentence =~ s/\d//g; # Drop digits
306 36         192 my @words = grep { $_ } map { lc $_ } split /\s+/, $sentence;
  291         504  
  291         508  
307 36         153 return @words;
308             }
309              
310             sub _stemword {
311 0     0   0 my ( $self, $word ) = @_;
312              
313 0         0 my @stems = $self->stemmer->stemWord($word);
314              
315 0 0       0 $word = [ sort @stems ]->[0]
316             if @stems;
317              
318 0         0 return $word;
319             }
320              
321             sub _get_sentences {
322 3     3   9 my ($self) = @_;
323              
324 3 100       5 unless ( @{ $self->sentences } ) {
  3         24  
325 2 100       21 my $contents = $self->file ? read_text( $self->file ) : $self->text;
326 2         226 $self->sentences( get_sentences($contents) );
327             }
328              
329 3         4453 return map { $_ } @{ $self->sentences };
  33         68  
  3         15  
330             }
331              
332             1;
333              
334             __END__