HatenaKeywordCloud - koyachiの日記

ちょっとまえからはてなキーワードAPIで遊んでたんですが、naoyaさんのエントリで取り上げられているHTML::TagCloudが面白そうなので日記のRSSを元にHatenaKeywordCloudを作ってみました。SideBarに貼れたらO'Reilly Radar見たいでかっこいいかなぁと思って。キーワード頻度が見れるので、adsense対策にもいいかもしれませんね。
出力結果はこんな感じ。

2005/07/08までの日記の出力結果と比べると、amazonが大きくなったり新出キーワードが増えていたりしてるので、よさそうですね。

以下は実装内容です。

処理手順

はてなダイアリー RSSの取得
RSSの各itemのcontent:encoded要素からはてなキーワードの抽出
はてなキーワードとその出現回数をHTML::TagCloudに渡す

はてなキーワード抽出には、形態要素解析プログラムMeCabを使い、名詞と未知語に対してはてなキーワードかどうかをはてなに問い合わせるようにしてみました。
作り始めた当初はプログラム起動のたびにそのRSS内での新出キーワードをはてなに問い合わせていたのですが、数日分のキーワードまとめた問い合わせだと結構時間がかかるので、一度問い合わせたキーワードはプログラムを動作させるサーバー上のDBに保存し(KeywordCloud::Model::*)、そちらを優先して検索するようにしました。

WebService::Hatena::Diary::Keyword(モジュール名はWebService::Hatena::Diary::Keyword::Simple, WebService::Hatena::Keyword、WebService::Hatena::Search,とどれにするか迷いましたがとりあえずこれにしました。はてな検索の応答だからSearchが正しいのかも)はとりあえず作ってみたモジュールで、キーワード有無の応答程度の機能しか無く、存在するキーワードの場合ははてな検索から帰ってきたRSSのitem該当キーワードの以下をそのまま返しています。

今回は単語抽出のためにMeCabを使ったんですが、あとではてなダイアリーキーワード自動リンクAPIがあることを知りました。はてなキーワードのみの抽出なら本来こちらを使うべきですね。MeCabの場合辞書に登録されて無い単語は検出できないので、デフォルトの辞書のままの場合、例えばmod_perlだとmodとperlに分かれてしまう現象が見られました。それでキーワード全部取得方法、あるいは他の方法無いかさがしてて自動リンク APIがあることを知ったんですが。

あとこれも作った後にわかったんですけど、貼る手段がなさそうですね。iframeとかjavascript(javascriptはもしかしたらできるのかな？)とか。負荷とか勝手広告対策等でそうなっているんでしょうが。先に調べておくべきだったかも。

というかhatena moduleとしてどうですかね。キーワード抽出機能は(offされてなければ)常に動いてるし、おとなり日記とか出すときにキーワード頻度計算してそうだし。時計とかblog petと同系列として。でも喜ぶのはgeekくらいか？需要無いかなぁ。

source

ソース一式
以下はメインのkeywordcloud.plのソースです。

#!/usr/local/bin/perl -w
use strict;
use warnings;
use utf8;
use lib "./lib"; 
use XML::RSS;
use LWP::Simple;
use HTML::TreeBuilder;
use MeCab;
use WebService::Hatena::Diary::Keyword;
use KeywordCloud::Model::Keyword;
use KeywordCloud::Model::Ngword;
use HTML::TagCloud;
use Encode;

my $target_encode = 'euc-jp';
my (@keywords) = ();

my @arg = ($0, @ARGV);
my $mecab = new MeCab::Tagger(\@arg);
my $hatena_keyword = WebService::Hatena::Diary::Keyword->new;
my $rss = XML::RSS->new;
$rss->add_module(prefix => 'content', uri => 'http://purl.org/rss/1.0/modules/content/');

my $url = 'http://d.hatena.ne.jp/koyachi/rss';
my $content = get($url);
$rss->parse($content);

foreach my $item (@{$rss->{items}}) {
    my $encoded_content = $item->{content}->{encoded};
    my $p = HTML::TreeBuilder->new_from_content($encoded_content);
    $encoded_content = $p->as_text;
    $encoded_content = Encode::encode($target_encode, $encoded_content);

    for (my $m = $mecab->parseToNode($encoded_content); $m->hasNode() == 1; $m = $m->next()) {
        my $feature = $m->getFeature();
        $feature = Encode::decode($target_encode, $feature);

        if ((($feature =~ /^名詞,(.*?),.*/) && ($1 =~ /一般|サ変接続|固有名詞/)) ||
            ($feature =~ /^未知語,.*/)) {
            my $surface = my $surface_org = $m->getSurface();
            $surface = Encode::decode($target_encode, $surface);

            # 記号1文字はスキップ
            if ($surface =~ /[!\"#$%&\'()=~|`{}*\+<>?_\-^\\@\[\];:,.\/]/) {
                next;
            }

            # NGワードに含まれている場合はスキップ
            next if (is_ngword($surface));

            # 未知語でも、一度keywordsに登録したものはスキップ
            my $keyword_id = is_keyword($surface);
            if (defined $keyword_id) {
                aggregate_keyword($keyword_id);
                next;
            }

            # はてなキーワード検索
            my $item = $hatena_keyword->search($surface, 60);
            if ($item) {
                my $item_id = register_keyword($surface, $item->{link});
                aggregate_keyword($item_id);
            } else {
                # 見つからなかった単語はng_wordへ
                register_ngword($surface);
            }
        }
    }
}

@keywords = sort {$a->{keyword} cmp $b->{keyword}} @keywords;
my $cloud = HTML::TagCloud->new;
$cloud->add(Encode::encode($target_encode, lc($_->{keyword})), $_->{url}, $_->{count})
    for (@keywords);
my $o = <<HTMLOUT;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=euc-jp">
<title>keywordcloud</title>
</head>

<body>
<style>
 div.keywordcloud {font-family:Arial, Helvetica, sans-serif;line-height:19px;text-align:center;margin-bottom: 30px;width:200px;}
</style>
<div class="keywordcloud">
HTMLOUT
$o .= $cloud->html_and_css();
$o .= '</keywordcloud></body>';
print $o;


sub register_keyword {
    my ($keyword, $url) = @_;

    my $keyword_org = $keyword;
    $keyword =  Encode::encode($target_encode, lc($keyword));
    my @matched_keywords = KeywordCloud::Model::Keyword->search(title => $keyword);
    return $matched_keywords[0]->id if ($matched_keywords[0]);

    my $newword = KeywordCloud::Model::Keyword->create({
        title => $keyword,
        url => $url,
    });
    push @keywords, {id => $newword->id, keyword => $keyword_org, url => $url, count => 1,};
    return $newword->id;
}

sub register_ngword {
    my ($ngword) = shift;

    my $registerd_ngword = KeywordCloud::Model::Ngword->create({
        title => Encode::encode($target_encode, lc($ngword)),
    });
    return $registerd_ngword->id;
}

sub aggregate_keyword {
    my ($keyword_id) = @_;

    foreach my $kw (@keywords) {
        if ($keyword_id == $kw->{id}) {
            $kw->{count}++;
            return;
        }
    }
}

sub is_ngword {
    my ($word) = shift;

    my @ngwords = KeywordCloud::Model::Ngword->search(title => Encode::encode($target_encode, lc($word)));
    return undef if (!$ngwords[0]);
    return 1;
}

sub is_keyword {
    my ($word) = shift;

    my $word_org = $word;
    $word = Encode::encode($target_encode, lc($word));
    my @matched_words = KeywordCloud::Model::Keyword->search(title => $word);
	
    if ($matched_words[0]){
        if (!grep{$matched_words[0]->id == $_->{id}} @keywords) {
            push @keywords, {id => $matched_words[0]->id, keyword => $word_org, url => $matched_words[0]->url, count => 1,};
        }
        return $matched_words[0]->id;
    }
    return undef;
}