AnyEvent::Twitter::Streamでベイジアンフィルタの様子を見る

ツイートストリームをベイジアンフィルタでカテゴリ分けしていく様子を見てみました。
カテゴリとしてハッシュタグを利用します。

ハッシュタグが付いているツイートは、フィルタの学習テキストとなります。
ハッシュタグが付いていないツイートは、どのハッシュタグに近い内容となっているのかを推定します。
これを行なうプログラム。

use strict;
use warnings;use lib './lib';
use utf8;
use FindBin::libs;

use Text::MeCab;
use Classifier;
use Classifier::Filter::DBI;
use Encode;

use Config::Pit;
use AnyEvent::Twitter::Stream;

use DBI;
use DBIx::Class;

my ($username, $password) = do { @{ Config::Pit::get( 'twitter.com', require => {
    'username' => 'memememomo', })}{ qw/username password/ };
};
my $cl = Classifier->new;
my $cl_filter = Classifier::Filter::DBI->new(dbh => DBI->connect('dbi:mysql:classifier','root',''));
$cl->set_filter($cl_filter);

my $c = AnyEvent->condvar;

my $stream; $stream = AnyEvent::Twitter::Stream->new(
    username => $username,
    password => $password,
    method => 'sample',
    on_tweet => sub {
        my $tweet = shift;
        my $text = $tweet->{text};

        my $lang = $tweet->{user}{lang};
        return '' if(! $lang || $lang ne 'ja' || ! $text);

        if ($text =~ m/\#([a-zA-Z0-9]+)[^a-zA-Z0-9]?/) {
            my $cat = $1;
            while ($text =~ m/\#([a-zA-Z0-9]+)[^a-zA-Z0-9]?/g) {
                my $c = $1;
                $cl->train($text, $c);
                warn $text;
            }
            my $p = "カテゴリ: $cat -> " . $text;
            print encode('utf8', $p), "\n";
        } else {
            my $p = sprintf("推定カテゴリ: %s -> ", $cl->predict($text)) . $text;
            print encode('utf8', $p), "\n";
        }
    },
    on_error => sub {
        my $error = shift;
        warn "ERROR: $error";
    },
    on_eof => sub {

    },
    );

$c->recv;

推定カテゴリとツイート内容が表示されていきます。
だらだらと推定されていく様子が見れると思います。

この他に、学習データに登録されているカテゴリについて、twitter内で検索して、学習するようなスクリプトも動かします。

use strict;
use warnings;

use utf8;
use Encode;
use Net::Twitter::Lite;
use Config::Pit;
use lib './lib';
use Classifier;
use Classifier::Filter::DBI;

use DBI;

my ($username, $password) = do { @{ Config::Pit::get( 'twitter.com', require => {
    'username' => 'memememomo', })}{ qw/username password/ };
};

my $twit = Net::Twitter::Lite->new(username => $username, $password => $password);

my $dbh = DBI->connect('dbi:mysql:classifier','root','');

my $cl = Classifier->new;
my $cl_filter = Classifier::Filter::DBI->new( dbh => $dbh );
$cl->set_filter($cl_filter);


my $sth = $dbh->prepare("SELECT category FROM category_count");
$sth->execute();
while (my $category = $sth->fetchrow) {
    print "$category\n";
    search_tag($category);
}
$sth->finish;

undef $sth;
$dbh->disconnect;


sub search_tag {
    my $tag = shift;

    my $response = $twit->search({ q => '#'.$tag, lang => 'ja' });

    my $count = @{$response->{results}};
    for my $result ( reverse( @{$response->{results}} ) ) {
        my $text = Encode::encode('utf8', $result->{text});
        $cl->train($text, $tag);
    }
}

裏で、このプログラムを定期的に動かして、ベイジアンフィルタにどんどん学習させます。

どんどんと分類が正確になっていく様子が見られるようになるので、面白いんじゃないかと思います。

文章が短いせいか、学習効率が悪いみたいですが。