File Coverage

blib/lib/Redis/Bayes.pm

Criterion	Covered	Total	%
statement	21	90	23.3
branch	0	24	0.0
condition	0	5	0.0
subroutine	7	19	36.8
pod	4	4	100.0
total	32	142	22.5

package Redis::Bayes;
use Redis;
use v5.10;
use List::Util qw/sum/;
use Carp;
use Moo;
use Lingua::StopWords qw/getStopWords/;
use strict;

our $VERSION = '0.023';

has stopwords => (
  is => 'rw',
  lazy => 1,
  builder => '_build_stopwords',
);

has redis => (
  is => 'ro',
  builder => '_build_redis',
);

has prefix => (
  is => 'ro',
  default => sub {'bayes:'},
);

has tokenizer => (
  is => 'rw',
  lazy => 1,
  builder => '_build_tokenizer',
);

sub _build_redis {
  return Redis->new(
    reconnect => 2,
    every => 100
  );
}

sub _build_stopwords {
  return getStopWords('en');
}

sub _build_tokenizer {
  my $self = shift;
  return sub {
    my ($txt) = @_;
    my @words = grep {
      !$self->stopwords->{$_}
    } grep { $_ } split /[\W_-]+/, lc $txt;
    return @words;
  };
}

sub _tokenize {
  my ($self,$txt) = @_;
  return $self->tokenizer->($txt);
}

sub _word_counts {
  my ($self, @words) = @_;
  my %counts;
  $counts{$_}++ for @words;
  return \%counts;
}

sub flush {
  my $self = shift;
  for my $cat ($self->redis->smembers($self->prefix . 'categories')) {
    $self->redis->del($self->prefix . $cat);
  }
  $self->redis->del($self->prefix . 'categories');
  return 1;
}

sub train {
  my ($self,$category,$text) = @_;
  $self->redis->sadd($self->prefix . 'categories', $category);
  my $wc = $self->_word_counts($self->_tokenize($text));
  while (my ($w,$c) = each(%$wc)) {
    $self->redis->hincrby($self->prefix . $category, $w, $c);
  }
  return 1;
}

sub untrain {
  my ($self, $category, $text) = @_;
  my $wc = $self->_word_counts($self->_tokenize($text));
  my ($cur,$new);
  while (my ($w,$c) = each(%$wc)) {
    $cur = $self->redis->hget($self->prefix . $category, $w);
    if ($cur) {
      $new = int($cur) - $c;
      if ($new > 0) {
        $self->redis->hset($self->prefix . $category, $w, $new)
      }else{
        $self->redis->hdel($self->prefix . $category, $w);
      }
    }
  }
  if ($self->_total($category) == 0) {
    $self->redis->del($self->prefix . $category);
    $self->redis->srem($self->prefix . 'categories', $category);
  }
  return 1;
}

sub classify {
  my ($self, $text, $args) = @_;
  $args //= {};
  my $scores = $self->_score($text);
  return if (not $scores);
  my @d = sort { $scores->{$b} <=> $scores->{$a} } keys %$scores;
  return 'empty data store' if (not @d);
  if ($args->{return_all}) {
    return join ',', map { "$_:" . $scores->{$_} } @d;
  }
  return ($scores->{$d[0]} ? $d[0] : 'unclassified');
}

sub _score {
  my ($self, $text) = @_;
  my $wc = $self->_word_counts($self->_tokenize($text));
  my %scores;
  for my $category ($self->redis->smembers($self->prefix . 'categories')) {
    my $total = $self->_total($category);
    next if ($total == 0);
    $scores{$category} = 0.0;
    while (my ($w,$c) = each %$wc) {
      my $score = $self->redis->hget($self->prefix . $category, $w);
      croak "invalid values in Redis" unless (not $score or $score > 0);
      next if not $score;
      $scores{$category} += $score / $total;
    }
  }
  return \%scores;
}

sub _total {
  my ($self, $category) = @_;
  my $total = sum($self->redis->hvals($self->prefix . $category));
  return 0 if (not $total);
  croak "error in hvals" unless ($total >= 0);
  return $total;
}



1;

__END__