Rを使ってコーパスで観察された頻度を処理する

# はじめに

コーパス言語学 [2] を勉強していたら，コーパスで観察された頻度を処理する時に使われる代表的な指標がでてきました．「これを R で書いてみたぞ」という記事です．ソースコードはここに置きました．

https://github.com/kazy0324/cooccurrence_analysis_with_r

（自分を含めた）文系の人にもできるだけ分かりやすく書くことを意識したので冗長なところがあると思います．間違えた箇所や，「もっと簡潔に書けるよ！」という意見があれば是非教えてください．

# データについて
## データの出どころ

今回使ったコーパスは言語学ではド定番の BNC です．検索インターフェイスは色々あるけれど，僕は [Sketch Engine](https://www.sketchengine.co.uk/) を使っています．有料だけど，色んな機能が使えて楽しいです．登録後一ヶ月は無料で使えるので，言語学で卒論書いたりする学部生さんも是非．

## データの取り方
### 何を探すの？

とりあえず，石川 [2] の六章章末問題 (p.133) の (3) を解くことにします．

> British National Corpus で，beautiful + woman [place, face, countryside, day, house, hair] のコロケーションの中心語頻度・共起語頻度・共起頻度を調べた上で，それぞれ，F, D, J, Cos, S, MI, G^2, t の指標値を計算してみましょう

というわけで， BNC コーパスから beautiful {woman, place, face, countryside, day, house, hair} の共起頻度を調べるということになりました．

### どうやって探すの？

**CQL (Corpus Query Language)** という言語を使ってコーパスからデータを取り出します．これを使うと，一語以上の組み合わせで検索ができたりして便利なのです．正規表現とかも使えるので研究でコーパスを使う人は覚えるといいと思います．英語だと[こんな動画](https://youtu.be/nOMr_D6ISRM)もあります．

今回の場合，基本はこの形を使います．ざっくり中身を説明すると「『beautifulという形容詞』の後ろに『targetという名詞』がくるやつ」という意味になっています．

`[lemma="beautiful"& tag = "J.*"][lemma="target" & tag ="N.*"]`

この表記の "target" となっている箇所に共起語を入れると beautiful X という形のコーパス上での頻度が得られます．

### 結果

今回のデータには BNC (tagged by CLAWS) を使います．同じ BNC でもこちらの方が品詞パーサーの精度が高い気がするので．

- BNC 全体の総語数: 96263399
- 中心語 *beautiful* 頻度: 8259

共起語と共起頻度は次の通りです．

| コロケーション | 共起頻度 | 共起語 | 共起語頻度 |
|:-:|:-:|:-:|:-:|
| beautiful woman  | 199  |  woman |57306|
| beautiful place |  87 | place  |51829|
| beautiful countryside | 48  | countryside  |3429|
| beautiful day |  46 | day  |89236|
| beautiful house |54| house  |42871|
| beautiful hair |35| hair  |13833|

この数値をもとに色々計算していきたいと思います．

# 色々な指標

準備として上の数値を変数に代入してしまいましょう．以降ではこの変数を使って色々と計算をしていきます．まずは共起表現全体の頻度を collocation ベクトルに代入します．

```freq_test.r
beautiful_woman <- 199
beautiful_place <- 87
beautiful_countryside <- 48
beautiful_day <- 46
beautiful_house <- 54
beautiful_hair <- 35
# 一つのベクトルに共起頻度をまとめる
collocation <- c(
  beautiful_woman, beautiful_place, b_countryside, 
  beautiful_day, beautiful_house, beautiful_hair
  ); collocation
```

そして，中心語 beautiful と共起語 {woman, place, countryside, day, house, hair} をそれぞれベクトル x と y に代入します．

```freq_test.r
# コーパス全体の語数（BNCにおける語数は一億
N <- 96263399 

# 中心語 beautiful の頻度
x <- 8259 

# 共起語頻度 Y の頻度
woman <- 57306
place <- 51829
countryside <- 3429
day <- 89236
house <- 42871
hair <- 13833
y <- c(woman, place, countryside, day, house, hair); y
```

## Dice
### 計算式

```math
{\rm Dice} = 2 \times \frac{F}{X+Y}
```
### Rのコード

```freq_test.r
Dice <- 2*(collocation / (x + y))
```

## Jaccard
### 計算式


```math
{\rm Jaccard} = \frac{F}{X+Y-F} 
```

### Rのコード

```freq_test.r
Jaccard <- collocation / (x + y - collocation);
```

## Cosine
### 計算式

```math
{\rm Cosine} = \frac{F}{\sqrt{X} \times \sqrt{Y}}
```

### Rのコード
```freq_test.r
Cosine <- collocation / ({sqrt(x)}*{sqrt(y)});
```

## Simpson

### 計算式

```math
{\rm Simpson} = \frac{F}{min(X,Y)}
```

### Rのコード

```freq_test.r
Simpson <- collocation / (min(x, y));
```


## MI（相互情報量）



### 計算式
```math
{\rm MI} = log_2\frac{F \times N}{X \times Y}
```
### Rのコード
```freq_test.r
MI <- log({(collocation*n)/(x*y)}, 2);
```

## 対数尤度比

### 計算式

**対数尤度比(log likelihood ratio)**には観察値(observed value)と期待値(expected value)が必要になります．ここで，期待値を *O* と，期待値を *E* と置き換えて次のような式を考えます．

```math
G^2 = 2 {\sum_{i=1}^{n}} \Bigl( O_i \times ( log_e O_i - log_e E_i) \Bigr)

```
### Rのコード

今回は少し面倒です．まずは観測値のテーブルを作成し，その値をもとに期待値のテーブルを作成しています．すごい原始的な方法で算出しています．

```freq_test.r
# 観察値のテーブル
observed <- matrix(
  c(collocation, x-collocation, y-collocation, (n-(y-collocation)-collocation-(x-collocation))), byrow=T, ncol=2)

# 観察値のテーブル（合計付き）
observed_with_sum <- addmargins(observed);

# 期待値のテーブル
expected <- matrix(
　c((observed_with_sum[1,3]*observed_with_sum[3,1]/observed_with_sum[3,3]), 
   (observed_with_sum[1,3]*observed_with_sum[3,2]/observed_with_sum[3,3]), 
   (observed_with_sum[2,3]*observed_with_sum[3,1]/observed_with_sum[3,3]), 
   (observed_with_sum[2,3]*observed_with_sum[3,2]/observed_with_sum[3,3])
　), ncol=2, byrow=T);
```
これでようやく対数尤度比を算出できます．

```freq_test.r
sqrtG <- 2*(sum(collocation*(sum(log(observed) - log(expected)))));
```
## t スコア
### 計算式

```math
t = \frac{1}{\sqrt{F}}\Biggl(F - \frac{X \times Y}{N} \Biggr)
```
### Rのコード

```freq_test.r
t <- (1/sqrt(collocation))*(collocation - (x*y/n));
```


# 一つの関数にまとめる

ここまで扱ってきたコードを freq_function という関数にまとめてします．引数は上に書いたものと同じように定義してあります．

- collocation: 分析をしたいコロケーションの頻度 (e.g., *good dog*)
- x: 中心語の頻度 (e.g., *good*)
- y: 共起語の頻度 (e.g., *dog*)
- n: コーパスの総語数

```r:freq_test.r
# 石川 (2012: Ch.6) の共起頻度の評価指標の為のスクリプト
freq_test <- function(collocation, x, y, n){
  ## 観察値と期待値の算出
  observed <- matrix(c(
    collocation, x-collocation, y-collocation, 
    (n-(y-collocation)-collocation-(x-collocation))), byrow=T, ncol=2)
  observed_with_sum <- addmargins(observed);
  expected <- matrix(c(
    (observed_with_sum[1,3]*observed_with_sum[3,1]/observed_with_sum[3,3]), 
    (observed_with_sum[1,3]*observed_with_sum[3,2]/observed_with_sum[3,3]), 
    (observed_with_sum[2,3]*observed_with_sum[3,1]/observed_with_sum[3,3]), 
    (observed_with_sum[2,3]*observed_with_sum[3,2]/observed_with_sum[3,3])), ncol=2, byrow=T);
  ## 各指標の計算
  Dice <- 2*(collocation / (x + y));
  Jaccard <- collocation / (x + y - collocation);
  Cosine <- collocation / ({sqrt(x)}*{sqrt(y)});
  Simpson <- collocation / (min(x, y));
  MI <- log({(collocation*n)/(x*y)}, 2);
  sqrtG <- 2*(sum(collocation*(sum(log(observed) - log(expected)))));
  t <- (1/sqrt(collocation))*(collocation - (x*y/n));
  result <- c(Dice, Jaccard, Cosine, Simpson, MI, sqrtG, t);
  names(result) <- c("Dice", "Jaccard", "Cosine", "Simpson", "MI", "sqrtG", "t");
  return(result)
}
```

上で定義した数値を入力していくと次のような結果が得られました．

||collocations | Dice | Jaccard | Cosine | Simpson | MI | sqrtG | t ||
|:----|:---|:---|:---|:---|:---|:---|:---|:---|:---|
|1 | beautiful woman | 0.006 |  0.003 | 0.009 |  0.024 | 5.339 | 1462.053 | 13.758 |
|2 | beautiful place | 0.003  | 0.001 | 0.004 |  0.011 | 4.290 | 515.405 | 8.851 |
| 3 | beautiful countryside | 0.008 |  0.004 | 0.009 | 0.014 | 7.350 | 487.192 | 6.886 |
| 4 | beautiful day | 0.001 |  0.000 |  0.002 | 0.006 | 2.587 | 164.501 | 5.654 |
| 5 | beautiful house | 0.002 | 0.001 | 0.003 | 0.007 | 3.876 | 289.363 | 6.848 |
| 6 |  beautiful hair | 0.003 | 0.002 | 0.003 | 0.004 | 4.882 | 236.427 | 5.715 |


# おわりに

以上，共起語の分析で有用に思われる情報をまとめました．本当はもっとエレガントな方法があるとは思うのですがとりあえずできる限りで書いてみました．誰かのお役に立てると嬉しいです．

間違いなどがある場合は遠慮なくご指摘ください．

# 参考文献

[1] Gries, Stefan Th. Statistics for Linguistics with R: a Practical Introduction. 2nd ed. Walter de Gruyter, 2013, 359p.
[2] 石川慎一郎. ベーシックコーパス言語学. ひつじ書房, 2012, 275p.