Hatena::Grouprekken

murawaki の雑記

2009-04-25

Mecab の出力を Juman.pm に食わせる

形態素解析MeCab の出力を JUMAN の Perl モジュールに食わせてみるテスト。ちょっとした実験が目的で作ったが、ぱっとしない結果だったので、やっつけ処理のまま放置されてるコード。意味もなくさらしてみる。

use JMecab;
my $jmecab = JMecab->new(dicdir => "$ENV{HOME}/local/lib/mecab/dic/jumandic");
my $result = $jmecab->analysis($input);
print $result->spec;

準備。MeCab の辞書としては、デフォルトの辞書ではなく JUMAN 系の辞書を MeCab のサイトからダウンロードして使う。この辞書は、JUMAN の辞書をもとに見出しと活用を展開して csv 形式にしたもの。パラメータ推定には京都テキストコーパスを使っているとのこと。基になった辞書はそこそこ古いようで、今の JUMAN とは代表表記のフォーマットが違う。

作った Perl モジュールは JMecab.pm。基本的に Juman.pm のコードを使いまわして、辻褄の合わない部分だけ上書き。コーディングスタイルからはじまってありとあらゆる部分が気に食わないが、やっつけ仕事だからと目をつぶる。

やってることは単純。MeCab の出力フォーマットを JUMAN 風に指定。それでは不十分だから辻褄合わせ。

  1. JUMAN の出力フォーマットに含まれる、品詞やら活用型やらの ID を MeCab は知らないから、Perl 側で探して与える。実際のところ、この ID に意味なんてないのだが。
  2. 未定義語の品詞細分類を JUMAN に合わせる。
  3. 代表表記を現在のフォーマットに変換。

これで Juman.pm のデータ構造に変換できる。そのまま KNP に食わせてもとりあえず動く。KNP には JUMAN の振る舞いに依存したやっつけルールがいろいろあるから、多分ちゃんと調べれば不具合がある。それに、空白の扱いとかをちゃんとテストしていない。

# mecab + JUMAN 辞書の出力を juman-perl に食わせるためのやっつけ
#
# Juman.pm とその親クラスのうち、JUMAN に依存する部分だけをオーバーライド
#
package JMecab;
use Carp;
use strict;
use vars qw/ %DEFAULT /;
use base qw/ Juman /;

use Juman::Result;
use Juman::Process;
use Juman::Grammar qw / $HINSI $BUNRUI $TYPE $FORM /;

# カスタマイズ用変数
%DEFAULT =
    ( command => &Juman::Process::which_command('mecab'),
      server  => $ENV{JUMANSERVER} || '',	# Juman サーバーのホスト名
      port    => 32000,				# Juman サーバーのポート番号
      timeout => 30,				# Juman サーバーの応答の待ち時間
      # option  => '-e2 -B',
      # rcfile  => $ENV{HOME}.'/.jumanrc',
      dicdir => '',
      mclass  => $Juman::Result::DEFAULT{mclass},
      ignorepattern => '',
    );
{
    use utf8;
    require Encode;
    $DEFAULT{option} = Encode::encode('euc-jp', '--node-format="%M\s%f[5]\s%f[4]\s%f[0]\s%f[1]\s%f[2]\s%f[3]\s\"%f[6]\"\n" --unk-format="%M\s%M\s%M\s未定義語\sTYPE\s*\s*\s\"\"\n"');
}

sub new {
    my $class = shift @_;
    my $this = {};
    bless($this, $class);

    if (@_ == 1){
	# 旧バージョンの形式で呼び出された場合の処理
	my ($argv) = @_;
	$this->setup( $argv, \%DEFAULT );
    } else {
	# 新しい形式で呼び出された場合の処理
	my (%option) = @_;
	$this->setup( \%option, \%DEFAULT );
    }

    unless ( $this->{OPTION}->{dicdir} ){
	carp "specify dicdir";
    }

    return $this;
}

sub setup {
    my ($this, $option, $default) = @_;

    my %opt;
    while( my( $key, $value ) = each %$option ){
	$key =~ s/^-+//;
	$opt{lc($key)} = $value;
    }
    while( my( $key, $value ) = each %$default ){
	if( defined $opt{$key} ){
	    $this->{OPTION}->{$key} = $opt{$key};
	} elsif( $value ){
	    $this->{OPTION}->{$key} = $value;
	}
    }
    $this->{PATTERN} = '^EOS$';
}

sub generate_option {
    my( $this, $remote ) = @_;

    return sprintf ("%s --dicdir=%s", $this->{OPTION}->{option}, $this->{OPTION}->{dicdir});
}

sub analysis {
    my( $this, $str ) = @_;
    my $lines = $this->juman_lines( $str );
    my $result = $this->filter_result($lines);
    new Juman::Result( result  => $result,
		       pattern => $this->pattern(),
		       mclass  => $this->{OPTION}->{mclass} );
}

our @ATTRS = ( 'midasi',
	       'yomi',
	       'genkei',
	       'hinsi',
	       # 'hinsi_id',
	       'bunrui',
	       # 'bunrui_id',
	       'katuyou1',
	       # 'katuyou1_id',
	       'katuyou2',
	       # 'katuyou2_id',
	       'imis' );
# mecab の出力には JUMAN の ID は付与されていないので変換
sub filter_result {
    my ( $this, $lines ) = @_;

    my $pattern = $this->pattern;
    my $result = [];
    foreach my $line (@$lines) {
	last if $line =~ /$pattern/;

	chomp($line);
	my @list = split(/\s/, $line);
	my $list = {};
	for (my $i = 0, my $l = scalar(@ATTRS) - 1; $i < $l; $i++) {
	    my $val = shift(@list);
	    $list->{$ATTRS[$i]} = ($val)? $val : '*';
	}
	my $imis = &format_imis (\@list); # 残りは意味素

	# EUC-JP でアクセスしないといけない
	{
	    use utf8;
	    if ($list->{hinsi} eq '未定義語') {
		&format_unk($list);
	    }
	}
	require Encode;
	my $hinsi = Encode::encode('euc-jp', $list->{hinsi});
	my $bunrui = Encode::encode('euc-jp', $list->{bunrui});
	my $katuyou1 = Encode::encode('euc-jp', $list->{katuyou1});
	my $katuyou2 = Encode::encode('euc-jp', $list->{katuyou2});

	my $hinsi_id = $HINSI->[0]->{$hinsi};
	my $bunrui_id = $BUNRUI->{$hinsi}->[0]->{$bunrui} || 0;
	my $katuyou1_id = $TYPE->[0]->{$katuyou1} || 0;
	my $katuyou2_id = $FORM->{$katuyou1}->[0]->{$katuyou2} || 0;

	push(@$result, sprintf("%s %s %s %s %s %s %s %s %s %s %s %s\n",
			       $list->{midasi}, $list->{yomi}, $list->{genkei},
			       $list->{hinsi}, $hinsi_id,
			       $list->{bunrui}, $bunrui_id,
			       $list->{katuyou1}, $katuyou1_id,
			       $list->{katuyou2}, $katuyou2_id,
			       $imis
			       ));
    }
    return $result;
}

sub format_imis {
    my ($list) = @_;

    return 'NIL' if ($list->[0] eq '""');

    # 古い代表表記対策
    use utf8;
    my $list2 = [];
    foreach my $str (@$list) {
	$str =~ s/\"//g;
	if ($str =~ /代表表記\:(.+)/) {
	    if (index ($1, '/') < 0) {
		$str = "代表表記:$1/$1";
	    }
	}
	push (@$list2, $str);
    }
    return '"' . join (" ", @$list2) . '"';
}

sub format_unk {
    my ($list) = @_;

    # 品詞の分類を設定
    use utf8;
    my $midasi = $list->{midasi};
    if ($midasi =~ /\p{Katakana}[\p{Katakana}ー]*/) {
	$list->{bunrui} = 'カタカナ';
    } else {
	my $flag = 1;
	# 全角英字
	# Latin # L& かつ InHalfwidthAndFullwidthForms だが...
	foreach my $c (split(//, $midasi)) {
	    my $n = ord($c);
	    unless (($n >= 0xFF21 && $n <= 0xFF3A)
		    || ($n >= 0xFF41 && $n <= 0xFF5A)) {
		$flag = 0;
		last;
	    }
	}
	$list->{bunrui} = ($flag)? 'アルファベット' : 'その他';
    }
}
    
1;