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

package Lingua::EN::Opinion;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Measure the emotional sentiment of text

our $VERSION = '0.1702';

use Moo;

use Lingua::EN::Opinion::Positive;
use Lingua::EN::Opinion::Negative;
use Lingua::EN::Opinion::Emotion;

use Carp qw( croak );
use File::Slurper qw( read_text );
use Lingua::EN::Sentence qw( get_sentences );
use Statistics::Lite qw( mean );
use Try::Tiny qw( try catch );

use strictures 2;
use namespace::clean;


has file => (
    is  => 'ro',
    isa => sub { die "File $_[0] does not exist" unless -e $_[0] },
);


has text => (
    is => 'ro',
);


has stem => (
    is      => 'ro',
    default => sub { 0 },
);


has stemmer => (
    is       => 'ro',
    lazy     => 1,
    builder  => 1,
    init_arg => undef,
);

sub _build_stemmer {
    try {
        require WordNet::QueryData;
        require WordNet::stem;

        my $wn      = WordNet::QueryData->new();
        my $stemmer = WordNet::stem->new($wn);

        return $stemmer;
    }
    catch {
        croak 'The WordNet::QueryData and WordNet::stem modules must be installed and working to enable stemming support';
    };
}


has sentences => (
    is       => 'rw',
    init_arg => undef,
    default  => sub { [] },
);


has scores => (
    is       => 'rw',
    init_arg => undef,
    default  => sub { [] },
);


has nrc_scores => (
    is       => 'rw',
    init_arg => undef,
    default  => sub { [] },
);


has positive => (
    is       => 'ro',
    init_arg => undef,
    default  => sub { Lingua::EN::Opinion::Positive->new },
);


has negative => (
    is       => 'ro',
    init_arg => undef,
    default  => sub { Lingua::EN::Opinion::Negative->new },
);


has emotion => (
    is       => 'ro',
    init_arg => undef,
    default  => sub { Lingua::EN::Opinion::Emotion->new },
);


has familiarity => (
    is       => 'rw',
    init_arg => undef,
    default  => sub { { known => 0, unknown => 0 } },
);


sub analyze {
    my ($self) = @_;

    my @scores;
    my ( $known, $unknown ) = ( 0, 0 );

    for my $sentence ( $self->_get_sentences ) {
        my $score = 0;
        ( $score, $known, $unknown ) = $self->get_sentence( $sentence, $known, $unknown );
        push @scores, $score;
    }

    $self->familiarity( { known => $known, unknown => $unknown } );

    $self->scores( \@scores );
}


sub averaged_score { shift->averaged_scores(@_) }

sub averaged_scores {
    my ( $self, $bins ) = @_;

    $bins ||= 10;

    my @scores = map { $_ } @{ $self->scores };

    my @averaged;

    while ( my @n = splice @scores, 0, $bins ) {
        push @averaged, mean(@n);
    }

    return \@averaged;
}


sub nrc_sentiment { shift->nrc_analyze(@_) };

sub nrc_analyze {
    my ($self) = @_;

    my $null_state = { map { $_ => 0 } qw/ anger anticipation disgust fear joy negative positive sadness surprise trust / };

    my @scores;
    my ( $known, $unknown ) = ( 0, 0 );

    for my $sentence ( $self->_get_sentences ) {
        my $score = {};

        ( $score, $known, $unknown ) = $self->nrc_get_sentence( $sentence, $known, $unknown );

        $score = $null_state
            unless $score;

        push @scores, $score;
    }

    $self->familiarity( { known => $known, unknown => $unknown } );

    $self->nrc_scores( \@scores );
}


sub get_word {
    my ( $self, $word ) = @_;

    $word = $self->_stemword($word)
        if $self->stem;

    return exists $self->positive->wordlist->{$word} ? 1
        : exists $self->negative->wordlist->{$word} ? -1
        : undef;
}


sub set_word {
    my ( $self, $word, $value ) = @_;

    if ($value > 0) {
        $self->positive->wordlist->{$word} = $value;
    }
    else {
        $self->negative->wordlist->{$word} = $value;
    }
}


sub nrc_get_word {
    my ( $self, $word ) = @_;

    $word = $self->_stemword($word)
        if $self->stem;

    return exists $self->emotion->wordlist->{$word}
        ? $self->emotion->wordlist->{$word}
        : undef;
}


sub nrc_set_word {
    my ( $self, $word, $value ) = @_;

    my %emotion;

    for my $emotion (qw(
        anger
        anticipation
        disgust
        fear
        joy
        negative
        positive
        sadness
        surprise
        trust
    )) {
        if (exists $value->{$emotion}) {
            $emotion{$emotion} = $value->{$emotion};
        }
        else {
            $emotion{$emotion} = 0;
        }
    }

    $self->emotion->wordlist->{$word} = \%emotion;
}


sub get_sentence {
    my ( $self, $sentence, $known, $unknown ) = @_;

    my @words = $self->tokenize($sentence);

    my $score = 0;

    for my $word ( @words ) {
        my $value = $self->get_word($word);
        if ( $value ) {
            $known++;
        }
        else {
            $unknown++;
        }

        $score += $value
            if defined $value;
    }

    return $score, $known, $unknown;
}


sub nrc_get_sentence {
    my ( $self, $sentence, $known, $unknown ) = @_;

    my @words = $self->tokenize($sentence);

    my $score = {};

    for my $word ( @words ) {
        my $value = $self->nrc_get_word($word);

        if ( $value ) {
            $known++;

            for my $key ( keys %$value ) {
                $score->{$key} += $value->{$key};
            }
        }
        else {
            $unknown++;
        }
    }

    return $score, $known, $unknown;
}


sub ratio {
    my ( $self, $flag ) = @_;

    my $numerator = $flag ? $self->familiarity->{unknown} : $self->familiarity->{known};

    my $ratio = $numerator / ( $self->familiarity->{known} + $self->familiarity->{unknown} );

    return $ratio;
}


sub tokenize {
    my ( $self, $sentence ) = @_;
    $sentence =~ s/[[:punct:]]//g;  # Drop punctuation
    $sentence =~ s/\d//g;           # Drop digits
    my @words = grep { $_ } map { lc $_ } split /\s+/, $sentence;
    return @words;
}

sub _stemword {
    my ( $self, $word ) = @_;

    my @stems = $self->stemmer->stemWord($word);

    $word = [ sort @stems ]->[0]
        if @stems;

    return $word;
}

sub _get_sentences {
    my ($self) = @_;

    unless ( @{ $self->sentences } ) {
        my $contents = $self->file ? read_text( $self->file ) : $self->text;
        $self->sentences( get_sentences($contents) );
    }

    return map { $_ } @{ $self->sentences };
}

1;

__END__