wikipedia dump を使って複合名詞を判定してみる

例えば「ウォークマン」を形態素解析器にかけると、mecabやChasenの場合だと、
「ウォーク|マン」と分けてしまう。
多くの場合、連接する名詞をくっつけて複合名詞とすればうまくいくけど、例外もたくさんある。
単純に連接名詞をとるだけだと、「世界最高新記録並の早さ」を「世界最高新記録並|の|早さ」と分けてしまう。
「世界最高新記録並」は確かにひとつの名詞と呼べそうではあるけど、なんか気持ち悪いです。
つまりどこで区切るのが適切かをコンピュータに自動的に判定させるのは難しいわけなんですが、

そこでwikipediaを使います。
wikipediaの各ページは人手で作られているため、その単語（複合名詞）のページが存在すること自体が、ひとつの単語として認めるかどうかを判断する大きな材料になります。

おまけにwikipediaで複合名詞判定（名詞判定でもある）を行っていれば、その後の処理で例えばwikipediaを使って単語拡張などするも容易にwikipediaのページにリンクできるので、wikipediaと連携して何かしたいときはいいんじゃないかと。

仕組み

基本的な仕組みは
文章を形態素解析して、複合語となりうる可能性のある名詞のかたまりをwikipediaのDBに問い合わせて、もしページが存在すれば複合語として認定する、というだけの話。
ただ、実際にプログラミングするとperlに慣れていないせいかゴチャゴチャした。

流れ

形態素解析して各素の品詞情報を得る。
隣り合う名詞を複合語となる可能性のあるかたまりとしてまとめて、checkキューへ積む。１つだけ独立している名詞についても要素数１のかたまりとしてcheckキューに積む。
そのかたまり（checkキュー）の各々に対して、部分集合（部分集合の内、要素が連接し合うものだけ）を求めて、文字数が大きいものから順にwikipediaDBに投げる。
1. もしページが存在すれば、その単語だけをokリストに入れる、前後の文字列は再びcheckキューに積む。
2. もしひとつもwikipediaDBにヒットしなければ、その要素（checkキューの要素）はcheckキューから消す。
checkキューの要素を全て消化したら、okリストにはwikipediaに存在する単語だけが残っている。

作り方

perlで実装してみたのでメモっときます。

step00

mecab本体とText::MeCabのインストール

step01

wikipediaのDBをダウンロード。
wikipediaDumpというのがあって、無料でダウンロードできます。
Wikipedia:データベースダウンロード

http://download.wikimedia.org/jawiki/latest/
で日本語のやつだけ落とせます。

いろいろなテーブルがありますが、それぞれの解説は
Wikipediaのダウンロードできるデータファイル一覧
に詳しいです。

とりあえず今必要なのはhttp://download.wikimedia.org/jawiki/latest/にある、
・jawiki-latest-page.sql.gz
・jawiki-latest-redirect.sql.gz
だけ。
これをmysqlにインポート。
pageテーブルのpage_titleのindexを作っていない場合は作ります。

create index title_index on page(page_title(30));

30の値は大きければ大きいほど高速にselectできるようになるみたいです。(MySQL 高速化メモ)
page_titleのインデックスを正確に作らなければ一度のチェックで1000ms以上かかりとても使い物になりません。

main.pl

#!/usr/bin/perl
require "./mecab.pl";

use strict;
use warnings;
use Error qw(:try);
use Data::Dumper;

use DBI;
use Encode;
use Jcode;

#
#opning
#
print "########################################\n";
print "##\n";
print "##start 複合語関係\n";
print "##\n";

#
#connect DB
#
my $user = 'user1';
my $passwd = 'aaaa';
my $db = DBI->connect('DBI:mysql:wiki:localhost;mysql_socket=/opt/lampp/var/mysql/mysql.sock', $user, $passwd,{RaiseError=>0,PrintError=>1,AutoCommit=>1});

#
#main
#
# 引数の文字列（文章）を与えると、複合名詞を考慮した名詞リストを返す。
# 
#
sub main{
	#
	#mecabing
	#
	
	my @mecabed = mecabpg::getParse($_[0]);
	my $mecabedLen = @mecabed;
	my @names = @mecabed[0..($mecabedLen/3-1)];
	my @types = @mecabed[($mecabedLen/3)..($mecabedLen/3*2-1)];
	
	#print Dumper @mecabed;
	print Dumper @names;
	print Dumper @types;
	
	#
	#複合語可能性単位に分割
	#
	my $startI = -2;
	my $lastI = -2;
	my @compNames = ();
	my $cnt = -1;
	for(my $i=0; $i<@names; $i++){
		if(index($types[$i], "名詞") == 0 || index($types[$i], "接頭詞,名詞接続") == 0){
			#print "$i:".@names[$i]." startI:$startI\n";
			if($lastI == $i-1){#連続している
				my $j = $i-$startI;
				#$compNames[$cnt] = ();
				$compNames[$cnt][$j] = $names[$i];
				#print "j:$j i:$i startI:$startI cnt:$cnt $names[$i]\n"
			}else{#連続していない
				$cnt ++;
				$compNames[$cnt][0] = $names[$i];			
				$startI = $i;
			}
			$lastI = $i;
		}
	}
	print Dumper @compNames;
	
	#
	#wikiに問い合わせて、存在するものだけをokArrに入れる
	#問い合わせる前に、複合語の可能性のあるものは、部分集合をとってきて、もしヒットすればヒットしたものだけをokArrに。
	#残りはcompNamesに入れる。
	#compNamesのlenが0になったら処理終了。
	#
	my @okArr = ();
	LOOP1:for(my $i=0; $i<@compNames; $i++){
		#print Dumper @compNames;
		if(! defined($compNames[$i])){##削除されているなら飛ばす
			#print "jump\n";
			next LOOP1;
		}
		#print Dumper $compNames[$i];
		
		#print "test:".@compNames[$i]->[0]."\n";
		#print "len:".@compNames[$i]->length;
		my @arrForSubset = ();
		my $cnt = 0;
		while(defined($compNames[$i]->[$cnt])){##lenのとりかたがわからんからwhile使ってやってる
			push @arrForSubset, $compNames[$i]->[$cnt];
			$cnt ++;
		}	
	
		#my @arr = subset(\@compNames[$i]);
		my @arr = subset(@arrForSubset);
		#print Dumper @arr;
		my $longestNoun = $arr[0];
		#print "longestNoun:$longestNoun\n";
	
		foreach my $noun (@arr){
			#print $noun."\n";
			my $exsitNounRes = exsitNoun($noun);
			#print "exsitNounRes:$exsitNounRes\n";
			if($exsitNounRes ne ""){
				push @okArr, $exsitNounRes;
				my @arr2 = split(/\Q$noun\E/, $longestNoun);#http://www.din.or.jp/~ohzaki/perl.htm
				#print Dumper @arr2;
				if(defined($arr2[0])){
					#print '@arr2[0] ne ""'."\n";
					my $l = @compNames;
					my @mecabedNouns = getMecabedNouns($arr2[0]);
					my $cnt2 = 0;
					foreach my $str (@mecabedNouns){
						$compNames[$l][$cnt2] = $str;
						$cnt2 ++;
					}
				}
				if(defined($arr2[1])){
					#print '@arr2[1] ne ""'."\n";
					my $l = @compNames;
					my @mecabedNouns = getMecabedNouns($arr2[1]);
					my $cnt2 = 0;
					foreach my $str (@mecabedNouns){
						$compNames[$l][$cnt2] = $str;
						$cnt2 ++;
					}
				}
				delete $compNames[$i];
				$i = 0;
				next LOOP1;
			}
		}
		##ひとつもwikiにhitしなければ破棄
		delete $compNames[$i];
		$i = 0;
		next LOOP1;
	}
	
	print "\nmain result:\n";
	print Dumper @okArr;
}
##test ok
my $txt1 = "新機能搭載式のデジタルノイズキャンセリングに惹かれて、YOU TUBEの鑑賞。アメリカで世界新記録を達成しました。";
main($txt1);



#############以下utils##############

#
#getMecabedNouns
#
# 引数に複合語あるいは普通の単語なる文字列を与えると、mecabで分解して、名詞として連接するものを配列として返す。
# ただし、最初に現れるひとかたまりしか返さない。
# 制約：引数に与える文字列は、形態素解析したときすべて名詞（または名詞と判断されるもの）でなければならない。
#
sub getMecabedNouns{
	#print "getMecabedNouns()\n";
	my ($noun) = @_;

	my @mecabed = mecabpg::getParse($noun);
	my $mecabedLen = @mecabed;
	my @names = @mecabed[0..($mecabedLen/3-1-1)];#最後の-1はEOT排除のため
	#my @types = @mecabed[($mecabedLen/3)..($mecabedLen/3*2-1)];

	#print Dumper @mecabed;
	#print Dumper @names;
	
	return @names;
}
##test ok
#getMecabedNouns("新機能搭載式");

#
#exsitNoun
#
# 引数の単語が存在するかどうかをチェック。
# 存在しなければ空文字（""）、存在すればredirect先の単語を返す。
#
sub exsitNoun{
	my ($noun) = @_;

	print "exsitNoun(), $noun\n";
	
	
	my $sth = $db->prepare("SET NAMES utf8");
	$sth->execute;

	$sth = $db->prepare("SELECT * FROM page WHERE page_title=".$db->quote($noun)." limit 1");
	$sth->execute;
	my @a = $sth->fetchrow_array;
	$sth->finish;
	if(@a == 0){#not exist
		print "not exist\n";
		return "";
	}else{#exist
		print "exist\n";
		#print @a[0]." : ".@a[5]."\n";
		if($a[5] == 1){
			print "page_id:".$a[0]."\n";
			$sth = $db->prepare("SELECT * FROM redirect WHERE rd_from=".$a[0]." limit 1");
			$sth->execute;
			my @a2 = $sth->fetchrow_array;
			if(@a2 == 0){
				return $noun;
			}else{
				return $a2[2];
			}
		}else{
			return $noun;
		}
	}
}
##test ok
#my $exsitNounRes = exsitNoun("ノイズキャンセリング");
#print "exsitNounRes:$exsitNounRes\n";


#
#文字数順にソート 降順
#
sub hikaku {
    my($alen) = length($a);
    my($blen) = length($b);

    if ($alen == $blen) {
        return 0;
    } elsif ($alen > $blen) {
        return -1;
    } elsif ($alen < $blen) {
        return 1;
    }
}
##test ok
#my @aaa = ( "AA", "AAA", "A" );
#@aaa = sort hikaku @aaa;
#print "@aaa\n";


#
#部分集合
#正確には一部の部分集合。隣り合う要素しか結びつけてはならないため。
#引数は配列。
#返り値は文字数順にソート
#式の説明：図で書くと三角形が交互に現れるからそいつをforでやってるだけ。
#
sub subset {
	my $len = @_;
	my $f_right = 1;
	my $offset_right = 0;
	my $offset_left = 0;
	my @arr = ();

	for(my $k=0; $k<$len; $k++){
		#print " k:$k\n";
		##三角形 
		for(my $i=0; $i<$len-$k; $i++){#$len-$kは高さおよび最大横幅
			#print " i:$i   ";
			my $str = "";
			for(my $j=$offset_left; $j<$len-$offset_right-$i; $j++){#$len-$offset_rightはその行の横幅
				#print " j:$j ";
				if($f_right==1){
					$str .= $_[$j];
				}else{
					$str .= $_[$j+$i];
				}
			}
			#print "  str:$str\n";
			push @arr, $str;
		}
		if($f_right==1){
			$offset_left ++;
			$f_right = 0;
		}else{
			$offset_right ++;
			$f_right = 1;
		}
	}
	return sort hikaku @arr;
}
##test ok
#my @list = ("a","b","c","d","e");
#my @res = subset(@list);
#print Dumper @res;



#
#disconnect DB
#
$db->disconnect;

print "-------end-------\n\n";

mecab.pl

package mecabpg;
#!/usr/bin/perl

#use strict;
use warnings;
use Error qw(:try);
use Data::Dumper;
use Text::MeCab;

#
#opning
#
print "########################################\n";
print "##\n";
print "##start mecab\n";
print "##\n";

#
#main
#
my $mecab = Text::MeCab->new();
#test
#my @res = &getParse("おはようございます");
#print Dumper @res;


#--------------
#getParseElementCnt
#--------------
sub getParseElementCnt{
	return 3;
}

#--------------
#getParse
#--------------
sub getParse{
	my ($str) = @_;
	my $n = $mecab->parse($str);

	my @surface = ();
	my @feature = ();
	my @cost = ();

	push(@surface, $n->surface);
	push(@feature, $n->feature);
	push(@cost, $n->cost);

	while ($n = $n->next) {
		push(@surface, $n->surface);
		push(@feature, $n->feature);
		push(@cost, $n->cost);
	}

	return @surface, @feature, @cost;
}

#Don't delete next line.
1;

実行結果 mecabを普通に使うだけ

入力文：新機能搭載式のデジタルノイズキャンセリングに惹かれて、YOU TUBEの鑑賞。アメリカで世界新記録を達成しました。
出力：

新接頭詞,名詞接続,*,*,*,*,新,シン,シン
機能名詞,サ変接続,*,*,*,*,機能,キノウ,キノー
搭載名詞,サ変接続,*,*,*,*,搭載,トウサイ,トーサイ
式名詞,接尾,一般,*,*,*,式,シキ,シキ
デジタルノイズキャンセリング名詞,一般,*,*,*,*,*
YOU 名詞,固有名詞,組織,*,*,*,*
TUBE 名詞,一般,*,*,*,*,*
鑑賞名詞,サ変接続,*,*,*,*,鑑賞,カンショウ,カンショー
アメリカ名詞,固有名詞,地域,国,*,*,アメリカ,アメリカ,アメリカ
世界名詞,一般,*,*,*,*,世界,セカイ,セカイ
記録名詞,サ変接続,*,*,*,*,記録,キロク,キロク
達成名詞,サ変接続,*,*,*,*,達成,タッセイ,タッセイ

実行結果今回作ったプログラムで

入力文：新機能搭載式のデジタルノイズキャンセリングに惹かれて、YOU TUBEの鑑賞。アメリカで世界新記録を達成しました。
出力：

main result:
$VAR1 = '機能主義';
$VAR2 = 'YouTube';
$VAR3 = '鑑賞';
$VAR4 = 'アメリカ';
$VAR5 = '世界記録';
$VAR6 = '新';
$VAR7 = '式';

「YOU TUBE」がちゃんと「YouTube」と認識されているのが素敵。
ちなみに「機能」が「機能主義」となっているのは、wikipedia上で「機能」という単語のページが「機能主義」というページにリダイレクトされているため。

なにか問題点やアドバイスがあったらコメントください。

仕組み

流れ

作り方

step00

step01

実行結果 mecabを普通に使うだけ

実行結果 今回作ったプログラムで

実行結果今回作ったプログラムで