Perl 6でNLP 5本ノック 『第4章: 形態素解析』 35~39 後編

こんにちは、Perl 6アドベントカレンダーの16日目の投稿になります。

NLP 5本ノックということで、東北大学の言語処理100本ノックの『第4章: 形態素解析』の 35~39までの5本のうちの後半2本をPerl 6で解きつつ解説をしていきたいと思います。

問題文は掲載しませんので、ブラウザの別窓で下記ページを参照しながらお楽しみください：
http://www.cl.ecei.tohoku.ac.jp/nlp100/#ch4

読み進める前に

注意!

• 読者レベルとしては、Perl 6アドベントカレンダー1日目で紹介したPerl 6 introductionなどのチュートリアルを一通り終えたレベルを想定しています。
• わかりやすく紹介するために、正確ではない表現がところどころ出てくるかもしれません。
• より正確な情報を知りたい場合は、Perl 6アドベントカレンダー1日目で紹介した公式ドキュメント や公式テストケースのroastなどを参照ください。
• 日本語訳が定着していないようなPerl 6独特の英単語を目にするかもしれません。基本的に解説中ではそのまま英単語で書き、その後補足しますのでご容赦ください。
• Perl 6のモットーはTMTOWTDI (やり方は一つじゃない) です。特に正解はありません。でも、「これのほうがもっとかっこよく簡潔に書けるよ！」といった指摘は大歓迎です！
• 元の38~39の問題文だと、30で生成されたデータをそれ以降で使う流れになっています。しかし、ここではバインダの使い方を紹介したかった関係で無視しているので注意してください。

準備

• 拙作のMeCabのPerl 6バインダを入れてください。下記コマンドで、READMEに書いてあるようにIPAdicも勝手に入ります。

$ zef install MeCab

38. ヒストグラム

コード

use MeCab;
use MeCab::Tagger;
use SVG;
use SVG::Plot;

my $text-fh = open "neko.txt", :r;
my MeCab::Tagger $tagger .= new;

my @bag-of-words = gather for $text-fh.lines {
    loop (my MeCab::Node $node = $tagger.parse-tonode($_); $node; $node = $node.next) {
        next if $node.stat == MECAB_BOS_NODE|MECAB_EOS_NODE;
        take $node.surface;
    }     
}.Bag.categorize(:as{ 1 }, { $_.value }).map({ .key => [+] .values }).sort: { $^a.key <=> $^b.key };

my $plot-fh = open 'histogram.svg', :w ;
$plot-fh.say(
    SVG.serialize: SVG::Plot.new(
        :title( 'ヒストグラム' ),
        :width( 400 ),
        :height( 300 ),
        :background( '#fffff0' ),
        :colors( '#4169e1' ),
        :label-font-size(10),
        :labels( @bag-of-words>>.key ),
        :values( item(@bag-of-words>>.value) ),
    ).plot(:stacked-bars)
);

$text-fh.close;
$plot-fh.close;

解説

前半

1. gather for take で単語の遅延リストを生成します

• $tagger.parse-tonodeで形態素解析して、takeで表記を取得します。

1. .Bag で表記、頻度のペアのリストを生成します
2. .categorize(:as{ 1 }, { $_.value }) で $_.valueをキーとするハッシュに対して、:as{ 1 }で値1を追加していきます。
3. .map({ .key => [+] .values })で、頻度がキーで、その頻度を持つ要素の数が値となるように変換します。このとき[+]は被演算子のリスト(i.e. 1のリスト)に対して+演算を行います。
4. .sort: { $^a.key <=> $^b.key } で頻度の昇順にソートします
5. 5.で生成された単語の出現頻度、その出現頻度をとる単語の種類数のペアのリストを変数に代入します

後半

• :stacked-barsを使います
• :labels( @bag-of-words>>.key ) で、単語の出現頻度を横軸に指定します
• :values( item(@bag-of-words>>.value) ) で、その出現頻度をとる単語の種類数を縦軸に指定します

よさそうです

39. Zipfの法則

コード

use MeCab;
use MeCab::Tagger;
use SVG;
use SVG::Plot;

my $text-fh = open "neko.txt", :r;
my MeCab::Tagger $tagger .= new;

my @bag-of-words = gather for $text-fh.lines {
    loop (my MeCab::Node $node = $tagger.parse-tonode($_); $node; $node = $node.next) {
        next if $node.stat == MECAB_BOS_NODE|MECAB_EOS_NODE;
        take $node.surface;
    }     
}.Bag.sort: { $^b.value <=> $^a.value };

my $plot-fh = open 'Zipf.svg', :w ;
$plot-fh.say(
    SVG.serialize: SVG::Plot.new(
        :title( 'Zipf' ),
        :width( 800 ),
        :height( 600 ),
        :background( '#fffff0' ),
        :colors( '#4169e1' ),
        :fill-width( 1.1 ),
        :label-font-size(10),
        :x( (1 .. +@bag-of-words).list>>.log10 ),
        :values( item(@bag-of-words>>.value>>.log10) ),
        :min-y-axis( -0.0001 ) # trick
    ).plot(:xy-points)
);

$text-fh.close;
$plot-fh.close;

解説

前半

1. gather for take で単語の遅延リストを生成します

• $tagger.parse-tonodeで形態素解析して、takeで表記を取得します。

1. .Bag で表記、頻度のペアのリストを生成します
2. .sort: { $^b.value <=> $^a.value } で値の降順にソートします。
3. 3.で生成された単語、出現頻度のペアのリストを変数に代入します

後半

• :xy-pointsを使います
• :x( (1 .. +@bag-of-words).list>>.log10 ) で、順位の対数をとったものを横軸に指定します
• :values( item(@bag-of-words>>.value>>.log10) ) で、頻度の対数を取ったものを縦軸に指定します

よさそうです

以上、Perl 6でNLP 5本ノック 『第4章: 形態素解析』 35~39 後編　でした。