古い記事
ランダムジャンプ
新しい記事

【ベイズ】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]
この記事に言及しているこのブログ内の記事

書いてる人：たつを