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__ |