view release on metacpan or  search on metacpan

author/loucsv.pl  view on Meta::CPAN

use strict;
use warnings;
use utf8;
use open OUT => qw/:utf8 :std/;
use autodie;
use Encode;
use FindBin;

=head1 USAGE

useage:
    cat mecab-ipadic-2.7.0-20060707/*.csv | perl loucsv.pl > lou.csv

original:
    http://chasen.org/~taku/blog/archives/2007/01/_mecab.html

=cut

my $ja2kana = get_ja2kana();

my $pos_form_okuri_map = {
    '名詞-*'                => '',
    'æ„Ÿå‹•è©ž-*'              => '',
    '接続詞-*'              => '',
    '連体詞-*'              => '',
    '動詞-仮定形'           => 'すれ',
    '動詞-仮定縮約１'       => 'すれ',
    '動詞-基本形'           => 'する',
    '動詞-体言接続'         => 'する',
    '動詞-体言接続特殊２'   => 'す',
    '動詞-文語基本形'       => 'する',
    '動詞-未然レル接続'     => 'せ',
   #'動詞-未然形'           => '',
   #'動詞-未然特殊'         => '',
    '動詞-命令ｅ'           => '',
    '動詞-命令ｒｏ'         => '',
    '動詞-命令ｙｏ'         => '',
   #'動詞-連用タ接続'       => '',
    '形容詞-ガル接続'       => '',
    '動詞-連用形'           => 'し',
    '形容詞-仮定形'         => 'なら',
    '形容詞-仮定縮約１'     => 'なら',
    '形容詞-仮定縮約２'     => 'なら',
    '形容詞-基本形'         => 'な',
    '形容詞-体言接続'       => 'な',
    '形容詞-文語基本形'     => '',
    '形容詞-未然ウ接続'     => 'だろ',
    '形容詞-未然ヌ接続'     => 'らしから',
    '形容詞-命令ｅ'         => 'であれ',
    '形容詞-連用ゴザイ接続' => '',
    '形容詞-連用タ接続'     => 'だっ',
    '形容詞-連用テ接続'     => 'に',
};

while (my $line = <>) {
    chomp $line;
    $line = decode('euc-jp', $line);

    my $lou = lou($line);
    next if not defined $lou;

    print $lou;
}

print <DATA>;

exit;

sub lou {
    my $feature = shift or return;

    # 表層形,左文脈ID,右文脈ID,コスト,品詞,品詞細分類1,品詞細分類2,品詞細分類3,活用型,活用形,原形,読み,発音
    my ($c, $d, $e, $cost, $pos, $f, $g, $h, $type, $form, $lemma, $i, $j) = split /,/, $feature;
    
    my $kana = $ja2kana->{$lemma};
    if (not defined $kana) {
        return;
    }
    
    my $pos_form = "$pos-$form";
    my $okuri = $pos_form_okuri_map->{$pos_form}; 
    if (not defined $okuri) {
        return;
    }

    $cost -= 1000;
    $cost = 1 if $cost <= 0;
    
    return join ",", $c, $d, $e, $cost, $pos, $f, $g, $h, $type, $form, $lemma, $i, $j, $kana, $okuri, "\n";
}

sub get_ja2kana {
    my $dic = {};
    open my $fh, '<:encoding(utf-8)', "$FindBin::Bin/ja2kana.csv";
    while (my $line = <$fh>) {
        chomp $line;
        next if $line =~ /^#/;
        
        my ($ja, $lou) = split /,/, $line;
        next if not $ja or not $lou;
        
        $lou =~ s/\s//g;
        
        next if $lou =~ /^[a-z]+$/i; 

        $dic->{$ja} = $lou; 
    }

    $dic;
}

__DATA__
ルー語,1,1,1200,その他,一般,*,*,*,*,*,*,*,ルー語,
元気,1,1,1200,その他,一般,*,*,*,*,*,*,*,ファイン,
一年,1,1,1200,その他,一般,*,*,*,*,*,*,*,ワンイヤー,
よいお年,1,1,1200,その他,一般,*,*,*,*,*,*,*,グッドイヤー,
良いお年,1,1,1200,その他,一般,*,*,*,*,*,*,*,グッドイヤー,
新年,1,1,1200,その他,一般,*,*,*,*,*,*,*,ニューイヤー,
お願いします,1,1,1200,その他,一般,*,*,*,*,*,*,*,プリーズ,
水臭い,1,1,1200,その他,一般,*,*,*,*,*,*,*,ウォーター臭い,
犬も歩けば棒に当たる,1,1,1200,その他,一般,*,*,*,*,*,*,*,犬もウォークすればポールにヒットする,
泣きっ面に蜂,1,1,1200,その他,一般,*,*,*,*,*,*,*,泣きっ面にビー,
やぶから棒,1,1,1200,その他,一般,*,*,*,*,*,*,*,やぶからスティック,
薮から棒,1,1,1200,その他,一般,*,*,*,*,*,*,*,薮からスティック,
藪から棒,1,1,1200,その他,一般,*,*,*,*,*,*,*,藪からスティック,
念には念を入れよ,1,1,1200,その他,一般,*,*,*,*,*,*,*,念には念をプットイン,
立て板に水,1,1,1200,その他,一般,*,*,*,*,*,*,*,立て板にウォーター,
青菜に塩,1,1,1200,その他,一般,*,*,*,*,*,*,*,青菜にソルト,
自己破産,1,1,1200,その他,一般,*,*,*,*,*,*,*,バイマイセルフ破産,
地球温暖化,1,1,1200,その他,一般,*,*,*,*,*,*,*,地球ホット化,
ちりも積もれば山となる,1,1,1200,その他,一般,*,*,*,*,*,*,*,トラッシュも積もればマウンテンとなる,
知らぬが仏,1,1,1200,その他,一般,*,*,*,*,*,*,*,ドントノウが仏,
論より証拠,1,1,1200,その他,一般,*,*,*,*,*,*,*,論よりエビデンス,
天下り問題,1,1,1200,その他,一般,*,*,*,*,*,*,*,ヘブン下りプロブレム,
負けるが勝ち,1,1,1200,その他,一般,*,*,*,*,*,*,*,ルーズするがウイン,
雨降って地固まる,1,1,1200,その他,一般,*,*,*,*,*,*,*,レイン降ってアース固まる,
石の上にも三年,1,1,1200,その他,一般,*,*,*,*,*,*,*,ストーンの上にもスリーイヤー,
石橋を叩いて渡る,1,1,1200,その他,一般,*,*,*,*,*,*,*,石橋をタップして渡る,
河童の川流れ,1,1,1200,その他,一般,*,*,*,*,*,*,*,河童のリバー流れ,
壁に耳あり、障子に目あり,1,1,1200,その他,一般,*,*,*,*,*,*,*,壁にイヤーあり、障子にアイズあり,
弘法も筆の誤まり,1,1,1200,その他,一般,*,*,*,*,*,*,*,弘法もペンシルの誤まり,