たつをの ChangeLog : 2013-07-27

前後の日: 2013-07-26 < > 2013-07-28
この月: 2013-07
別の年の同じ日: 2000 2002 2003 2004 2005 2006 2007 2008 2009 2010 2011 2012 2013 2015 2016 2017 2018 2019 2020 2021 2022 2024

【ベイズ】Naive Bayes による文書分類のサンプルプログラムを Complement Naive Bayes にアップグレード！【Perl】

2013-07-27-1 [Programming][Algorithm][NLP]

昨日のナイーブベイズの記事[2013-07-26-1]の続きです。
Perl のサンプルプログラムを少しいじって Complement Naive Bayes を実現します。

Complement Naive Bayes についての詳細は下記をどうぞ。
- 新はてなブックマークでも使われてるComplement Naive Bayesを解説するよ (射撃しつつ前転)
http://d.hatena.ne.jp/tkng/20081217/1229475900
- complement naive Bayes - 機械学習の「朱鷺の杜Wiki」

学習データと入力データ

この記事では前回と同じ物を使います。

t.c2w（学習データ）：TSV+CSV

政治	選挙:6,外交:3,防衛:2,予算:1,オスプレイ:2,独立:1,環境:1,医療:1,エネルギー:2
スポーツ	野球:9,移籍:2,速報:1,日本代表:8,サッカー:9,スタジアム:3,エネルギー:1
エンタメ	選挙:1,移籍:1,速報:1,不倫:4,結婚:6,離婚:7,ものまね:4,破綻:2,独立:1
科学	感染症:2,環境:2,医療:4,エネルギー:5,遺伝子:3,惑星:3,ニュートリノ:1

t.txt（入力データ）：

選挙 移籍 離婚 破綻
環境 医療 エネルギー 速報 遺伝子
防衛 オスプレイ 外交 破綻
速報 サッカー 日本代表 移籍

分類器だけ変更するバージョン

まずは、分類器だけ変更するバージョンです。前回の mkdat4nb.pl を用いて作った転置ファイル t.nb をそのまま使います。

分類器 nb.pl をいじって cnb-nb.pl とします。
データ読み込み時に Complement なのを計算するようにしています。

パッチを載せておきます。

*** nb.pl	Sat Jul 27 15:07:47 2013
--- cnb-nb.pl	Sat Jul 27 15:07:47 2013
***************
*** 21,27 ****
          foreach (@cats) {
              next if not /^(.+):(\d+)$/;
              my ($c, $f) = ($1, $2);
!             $cnt_wc{$w}{$c} = $f;
          }
      }
  }
--- 21,29 ----
          foreach (@cats) {
              next if not /^(.+):(\d+)$/;
              my ($c, $f) = ($1, $2);
! 	    foreach my $cat2 (grep {$c ne $_} keys %cnt_c) {
! 		$cnt_wc{$w}{$cat2} += $f;
! 	    }
          }
      }
  }
***************
*** 37,43 ****
          next if not defined $cnt_wc{$w};
          foreach my $c (keys %cnt_c) {
              my $wc = $cnt_wc{$w}{$c} || $min_freq;
!             $val{$c} +=  -1 * log($wc / $cnt_c{$c});
              $c2w{$c}{$w} = $wc if $wc >= 1;
          }
      }
--- 39,45 ----
          next if not defined $cnt_wc{$w};
          foreach my $c (keys %cnt_c) {
              my $wc = $cnt_wc{$w}{$c} || $min_freq;
!             $val{$c} -=  -1 * log($wc / ($cnt_w - $cnt_c{$c}));
              $c2w{$c}{$w} = $wc if $wc >= 1;
          }
      }

実行結果：

% ./cnb-nb.pl t.nb t.txt
> 選挙 移籍 離婚 破綻
エンタメ	-17.927	選挙:6,移籍:2
政治	-12.139	離婚:7,移籍:3,破綻:2,選挙:1
スポーツ	-11.075	選挙:7,離婚:7,破綻:2,移籍:1
科学	-10.194	選挙:7,離婚:7,移籍:3,破綻:2

> 環境 医療 エネルギー 速報 遺伝子
科学	-20.758	エネルギー:3,速報:2,環境:1,医療:1
政治	-14.596	エネルギー:6,医療:4,遺伝子:3,環境:2,速報:2
エンタメ	-14.197	エネルギー:8,医療:5,環境:3,遺伝子:3,速報:1
スポーツ	-14.097	エネルギー:7,医療:5,環境:3,遺伝子:3,速報:1

> 防衛 オスプレイ 外交 破綻
政治	-22.092	破綻:2
エンタメ	-15.625	外交:3,オスプレイ:2,防衛:2
科学	-12.7	外交:3,破綻:2,オスプレイ:2,防衛:2
スポーツ	-12.481	外交:3,破綻:2,オスプレイ:2,防衛:2

> 速報 サッカー 日本代表 移籍
スポーツ	-20.265	速報:1,移籍:1
エンタメ	-10.837	サッカー:9,日本代表:8,移籍:2,速報:1
科学	-9.809	サッカー:9,日本代表:8,移籍:3,速報:2
政治	-9.809	サッカー:9,日本代表:8,移籍:3,速報:2

データ変換器も変更するバージョン

実行時にいちいち Complement なのを計算するのはデータが大きくなると面倒なので、転置時にあらかじめ計算しておくバージョンです。

mkdat4nb.pl をいじって Complement の計算をさせるようにして、mkdat4.cnb.pl としました。これによる出力は「*.nb」ではなく「*.cnb」とします。

実行例：

% ./mkdat4cnb.pl t.c2w > t.cnb

パッチを載せておきます。

*** mkdat4nb.pl	Sat Jul 27 15:07:47 2013
--- mkdat4cnb.pl	Sat Jul 27 15:07:47 2013
***************
*** 23,28 ****
--- 23,38 ----
      print " $cat\t$cnt_c{$cat}\t$cnt_w\n";
  }
  
+ foreach my $w (keys %cnt_wc) {
+     my %cnt_tmp;
+     foreach my $cat1 (keys %{$cnt_wc{$w}}) {
+ 	foreach my $cat2 (grep {$cat1 ne $_} keys %cnt_c) {
+ 	    $cnt_tmp{$cat2} += $cnt_wc{$w}{$cat1};
+ 	}
+     }
+     %{$cnt_wc{$w}} = %cnt_tmp;
+ }
+ 
  foreach my $w (sort keys %cnt_wc){
      print "$w\t".join(",", map {"$_:$cnt_wc{$w}{$_}"}
                        sort {$cnt_wc{$w}{$b} <=> $cnt_wc{$w}{$a}}

そして、それにあわせて nb.pl もいじりました。cnb.pl とします。変更箇所は1行だけです。こちらもパッチ。

*** nb.pl	Sat Jul 27 15:07:47 2013
--- cnb.pl	Sat Jul 27 15:07:47 2013
***************
*** 37,43 ****
          next if not defined $cnt_wc{$w};
          foreach my $c (keys %cnt_c) {
              my $wc = $cnt_wc{$w}{$c} || $min_freq;
!             $val{$c} +=  -1 * log($wc / $cnt_c{$c});
              $c2w{$c}{$w} = $wc if $wc >= 1;
          }
      }
--- 37,43 ----
          next if not defined $cnt_wc{$w};
          foreach my $c (keys %cnt_c) {
              my $wc = $cnt_wc{$w}{$c} || $min_freq;
!             $val{$c} -=  -1 * log($wc / ($cnt_w - $cnt_c{$c}));
              $c2w{$c}{$w} = $wc if $wc >= 1;
          }
      }

実行結果：

% ./cnb.pl t.cnb t.txt
> 選挙 移籍 離婚 破綻
エンタメ	-17.927	選挙:6,移籍:2
政治	-12.139	離婚:7,移籍:3,破綻:2,選挙:1
スポーツ	-11.075	選挙:7,離婚:7,破綻:2,移籍:1
科学	-10.194	選挙:7,離婚:7,移籍:3,破綻:2

> 環境 医療 エネルギー 速報 遺伝子
科学	-20.758	エネルギー:3,速報:2,環境:1,医療:1
政治	-14.596	エネルギー:6,医療:4,遺伝子:3,環境:2,速報:2
エンタメ	-14.197	エネルギー:8,医療:5,環境:3,遺伝子:3,速報:1
スポーツ	-14.097	エネルギー:7,医療:5,環境:3,遺伝子:3,速報:1

> 防衛 オスプレイ 外交 破綻
政治	-22.092	破綻:2
エンタメ	-15.625	外交:3,オスプレイ:2,防衛:2
科学	-12.7	外交:3,破綻:2,オスプレイ:2,防衛:2
スポーツ	-12.481	外交:3,破綻:2,オスプレイ:2,防衛:2

> 速報 サッカー 日本代表 移籍
スポーツ	-20.265	速報:1,移籍:1
エンタメ	-10.837	サッカー:9,日本代表:8,移籍:2,速報:1
科学	-9.809	サッカー:9,日本代表:8,移籍:3,速報:2
政治	-9.809	サッカー:9,日本代表:8,移籍:3,速報:2

さきほどと同じです。

ソース一式

前回[2013-07-26-1]と今回のソースとサンプルデータ一式を tar ball にまとめましたのでどうぞ。

http://chalow.net/misc/nb-sample.tar.gz

記事もソースも予告無くアップデートされることがありますのでご了承ください。

- [を] 【ベイズ】Naive Bayes（単純ベイズ）による文書分類のサンプルプログラム【Perl】[2013-07-26-1]

この記事に言及しているこのブログ内の記事

【Perl関連記事リスト】Perl でテキスト処理やデータ処理 (2016-08-04)

【書評・感想】ブログ飯

2013-07-27-2 [BookReview][Kindle][Blog]

読みました！

■染谷昌利 / ブログ飯 - 個性を収入に変える生き方 [Kindle版]

無理しない稼ぎ方の大原則。専門知識がなくても、有名じゃなくても、妻一人子一人（＋ネコ一匹）を養える！　

テクニックありきではない人気ブログの作り方を解説したSNS時代の新しい生き方本。　
自分の好きなこと（個性）をネットで収入に変える方法を、根本となる考え方や具体的な収益方法を交えて解説しています。著者は人気ブログ「Xperia非公式マニュアル」を運営し、Google AdSenseの成功事例としても取り上げられたプロブロガー。ネットで集客して収益に結びつけるまでの道のりを体系的に学べる一冊です。

たまたまうまくいった人による現場レポート、といった感じです。ブログで飯を食うことを目指す人には参考になることが多いと思います。特に、組織に属さずやっていくかいなかの判断材料として。

まあ、なかなか一筋縄ではいかないな、という感想です。うまくいくときもあるんですけど、永続生がないんですよね。

あと、強力な奥さんの存在が心強いですよね。