Ruby
BCCWJ

BCCWJをRで調べてグラフを描くメモ

More than 1 year has passed since last update.

『現代日本語書き言葉均衡コーパス』(BCCWJ)をRで読み込んで集計したりグラフを描いたりするメモ。

tidyverse

データの集計とかを効率よくやるために、dplyrとtidyrというライブラリを使う。きれいなグラフを描画するためにggplot2というライブラリを使う。これらは個別にインストールすることもできるが、tidyverseというライブラリをインストールすれば一括で使えるようになる。

install.packages("tidyverse")

インストールしたらパッケージを読み込む。

library(tidyverse)

『現代日本語書き言葉均衡コーパス』(BCCWJ)

BCCWJのDVDに収録されているタブ区切りデータを使用する。DVDはアカデミックだと5万円ぐらいなので研究費とかで買う。DVDのどこかにcore_LUW.txtというファイルがある。BCCWJコアデータの長単位タブ区切りテキストである。これをRで読み込んで分析する。DVDから直接読み込むのは遅いので、あらかじめPCの適当なフォルダにコピーしておく。

お金がない場合は、青空文庫とか適当なデータをmecabで形態素解析してタブ区切りデータを作る(RMeCabというRのライブラリもあるらしい)。データの作成についてはここでは説明しない。DVDを持っている前提で話を進める。

データを読み込む

データの読み込みは、tidyverseに含まれるreadrパッケージを使うと便利。タブ区切りデータの場合はreadr::read_tsvを使う。

source <- read_tsv('core_LUW.txt', col_names = F, na = character() )

列名がないと不便なので列名をつける。列の定義はこことか参照。

colnames(source) <- c(
    'reg', 'sample_id', 'start', 'end',
    'b', 'suw', 'fix', 'var', 'lemma', 'lform',
    'wtype', 'pos', 'ctype', 'cform', 'wform',
    'orthbase', 'orth', 'orig', 'pron',
    'order', 'o_start', 'o_end', 's'
    )

コーパスの規模を確認

BCCWJコアデータは知恵袋(OC)、白書(OW)、ブログ(OY)、書籍(PB)、雑誌(PM)、新聞(PN)の6つのレジスタを含む。このレジスタごとにサンプル数、文数、文節数、長単位数を集計する。

source %>%
    group_by(reg, sample_id) %>%
    summarise(
        sentences = sum(s == 'B'),
        chunks = sum(b == 'B'),
        words = n()
    ) %>%
    group_by(reg) %>%
    summarise(
        samples = n(),
        sentences = sum(sentences),
        chunks = sum(chunks),
        words = sum(words)
    )

group_byでグループ化に使う列名を指定し、summariseでグループごとに集計などの処理を行う。n()はグループごとの総行数を求める。sum(name)はグループごとに列nameの合計を計算する。sum(name == value)は列nameの値がvalueである行の数を数える(理屈としてはname == valueの部分がtrueなら1、falseなら0として合計を計算している、と思う)。結果は以下のようになる。

# A tibble: 6 × 5
    reg samples sentences chunks  words
  <chr>   <int>     <int>  <int>  <int>
1    OC     938      6413  36740  94655
2    OW      62      6037  68449 158909
3    OY     471      7455  38577  98783
4    PB      83     10075  84736 199407
5    PM      86     12953  83078 194961
6    PN     340     17050 116960 273132

コアデータは各レジスタの短単位数が同程度になるようにサンプリングされているはずだが、長単位だとかなり差がでるようだ。

文の長さ

サンプルごとに語数/文数を計算して1文あたりの平均語数を調べる。

samples <-
    source %>%
    group_by(reg, sample_id) %>%
    summarise(
        sentences = sum(s == 'B'),
        words = n()
    ) %>%
    mutate(len = words / sentences)

文字数の場合は次のようにする。

samples <-
    group_by(reg, sample_id) %>%
    summarise(
        sentences = sum(s == 'B'),
        chars = sum(nchar(orig))
    ) %>%
    mutate(len = chars / sentences)

ヒストグラム

ggplot(samples) +
    aes(x = len) +
    geom_histogram() +
    facet_wrap(~reg)

Kobito.wLGmou.png

箱ひげ図

ggplot(samples) +
    aes(x = reg, y = len) +
    geom_boxplot()

Kobito.bNqBOI.png

語種

名詞のみに絞り込んで、レジスタごとの語種の内訳をグラフにする。

source %>%
    separate(pos, c("pos1", "pos2", "pos3", "pos4"), fill = "right") %>%
    filter(pos1 == "名詞") %>%
    group_by(reg, wtype) %>%
    summarise(n = n()) %>%
    ggplot() +
    aes(x = reg, y = n, fill = wtype) +
    geom_bar(stat = "identity", position = "fill") +
    theme_gray(base_family = "HiraginoSans-W3")

Kobito.22eFm1.png

さすがに白書は漢語が多い。

ジップの法則

語の頻度順位と頻度が反比例するという法則。

source %>%
    group_by(lemma, lform, pos) %>%
    summarise(n = n()) %>%
    ungroup %>%
    arrange(desc(n)) %>%
    mutate(rank = c(1:nrow(.))) %>%
    ggplot() +
    aes(x = log(rank), y = log(n)) %>%
    geom_line()

Kobito.9zM3jq.png

両対数グラフにすると、だいたいまっすぐになる。

異なり語数と延べ語数

source %>%
    group_by(reg, sample_id, lemma, lform, pos) %>%
    summarise(tokens = n()) %>%
    group_by(reg, sample_id) %>%
    summarise(types = n(), tokens = sum(tokens)) %>%
    ggplot() +
    aes(x = tokens, y = types, colour = reg) %>%
    geom_point()

Kobito.Rw2859.png

異なり語数と延べ語数が比例していないことが分かる。つまり、いわゆるTTR(Type-Token Ratio)は延べ語数が大きくなるほど小さくなる。