はじめに
統計学One Pointシリーズの『テキストアナリティクス』の学習時のまとめです。
この記事は、4章「法則と語句の重みおよび特徴語句抽出」の内容です。本で解説されている数式をRで実装します。詳しい解説は本を読んでね。細かい内容はこれから勉強します。とりあえず数式をプログラムで再現するのが目標です。
この章では、次のパッケージを利用します。
# 利用パッケージ library(RMeCab) library(dplyr) library(tidyr) library(ggplot2)
・テキストの前処理
テキスト(文書)に含まれる単語の頻度表を用意します。頻度表は、1つのグループのテキスト間で分析を行う場合と、2つのグループでそれぞれテキストをまとめてグループ間で分析を行う場合の2パターン用意します。
今回はハロー！プロジェクトの(ほぼ)同期グループの「こぶしファクトリー」と「つばきファクトリー」の楽曲の歌詞を使用します。
・グループ内比較用
まずはテキストファイルが保存してあるフォルダのファイルパスと抽出する品詞を指定して、形態素解析を行います。
# ファイルパスを指定 dir_path <- "text_data_cp932/kobushi" # 抽出する品詞を指定 PoS <- c("名詞") # 削除する語を指定 stop_words <- "[\\(\\)（）!?！？％,\\.…']" # 形態素解析 res_mecab <- RMeCab::docDF(dir_path, type = 1, pos = PoS) res_mecab[1:5, 1:8]
## TERM POS1 POS2 kobushi_001.txt kobushi_002.txt kobushi_003.txt ## 1 ' 名詞 サ変接続 0 0 0 ## 2 ( 名詞 サ変接続 0 0 2 ## 3 ) 名詞 サ変接続 0 0 2 ## 4 )「 名詞 サ変接続 0 0 0 ## 5 )」 名詞 サ変接続 0 0 0 ## kobushi_004.txt kobushi_005.txt ## 1 0 0 ## 2 14 0 ## 3 14 0 ## 4 0 0 ## 5 0 0
削除する単語TERMや品詞細分類POS2は色々考慮すべきですが、ここでは目視で確認した記号のみ取り除くことにします。
解析結果を単語文書行列と文書単語行列に変換します。
# 単語文書行列を作成 term_doc_mat <- res_mecab %>% dplyr::filter(!grepl(stop_words, TERM)) %>% .[, -(1:3)] %>% as.matrix() colnames(term_doc_mat) <- NULL term_doc_mat[1:10, 5:14]
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 0 0 0 0 0 5 0 0 0 0 ## [2,] 0 0 0 0 0 0 0 0 0 0 ## [3,] 0 0 0 0 4 0 0 0 0 0 ## [4,] 0 0 0 0 0 1 0 0 0 0 ## [5,] 0 0 0 0 0 0 0 0 0 0 ## [6,] 0 0 0 0 0 9 0 0 0 0 ## [7,] 0 0 0 0 0 3 0 0 0 0 ## [8,] 0 0 0 0 0 0 0 0 0 0 ## [9,] 0 0 0 0 0 1 0 0 0 0 ## [10,] 0 0 0 0 0 0 0 0 0 0
# 文書単語行列を作成 doc_term_mat <- res_mecab %>% dplyr::filter(!grepl(stop_words, TERM)) %>% .[, -(1:3)] %>% t() rownames(doc_term_mat) <- NULL doc_term_mat[10:19, 1:10]
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 5 0 0 1 0 9 3 0 1 0 ## [2,] 0 0 0 0 0 0 0 0 0 0 ## [3,] 0 0 0 0 0 0 0 0 0 0 ## [4,] 0 0 0 0 0 0 0 0 0 0 ## [5,] 0 0 0 0 0 0 0 0 0 0 ## [6,] 0 0 0 0 10 0 0 0 0 0 ## [7,] 0 0 0 0 0 0 0 0 0 0 ## [8,] 0 0 0 0 0 0 0 0 0 0 ## [9,] 0 0 0 0 0 0 0 0 0 0 ## [10,] 0 1 0 0 0 0 0 0 0 0
この2つのマトリクスは分析手法によって使い分けます。
これは1つのグループのテキストを比較する場合です。次は2つのグループを比較する場合のデータフレームを用意します。
・グループ間比較用
先ほどは複数のテキストを列または行に並べました。これを1つの列にまとめます。
# 不要な語を削除 res_mecab <- res_mecab %>% dplyr::filter(!grepl(stop_words, TERM)) # 頻度を集計 freq_df_x <- tidyr::tibble( term = res_mecab[["TERM"]], freq_x = rowSums(res_mecab[, -c(1:3)]) ) head(freq_df_x)
## # A tibble: 6 x 2 ## term freq_x ## <chr> <dbl> ## 1 1 11 ## 2 10 1 ## 3 100 4 ## 4 12 2 ## 5 2 16 ## 6 3 9
つまり全文書における各単語の頻度にします。
同じことをもう1つのグループのテキスト群に対しても行います。
# ファイルパスを指定 dir_path_y <- "text_data_cp932/tsubaki" # 形態素解析 res_mecab_y <- RMeCab::docDF(dir_path_y, type = 1, pos = PoS) %>% dplyr::filter(!grepl(stop_words, TERM)) # 頻度を集計 freq_df_y <- tidyr::tibble( term = res_mecab_y[["TERM"]], freq_y = rowSums(res_mecab_y[, -c(1:3)]) ) head(freq_df_y)
## # A tibble: 6 x 2 ## term freq_y ## <chr> <dbl> ## 1 1 13 ## 2 10 4 ## 3 19 1 ## 4 19800 1 ## 5 2 6 ## 6 5 1
2つのデータフレームを結合します。ただし同じ単語列ではないため、dplyr::full_join()によって結合します。
# 単語文書行列を作成 freq_df_xy <- dplyr::full_join( freq_df_x, freq_df_y, by = "term" ) %>% dplyr::mutate( freq_x = replace_na(freq_x, 0), freq_y = replace_na(freq_y, 0) ) %>% dplyr::mutate(freq_xy = freq_x + freq_y) head(freq_df_xy)
## # A tibble: 6 x 4 ## term freq_x freq_y freq_xy ## <chr> <dbl> <dbl> <dbl> ## 1 1 11 13 24 ## 2 10 1 4 5 ## 3 100 4 0 4 ## 4 12 2 0 2 ## 5 2 16 6 22 ## 6 3 9 0 9
これを単語頻度表の基本形とします。分析手法によっては、ここに手を加えてから分析します。
延べ語数$N$と異なり語数$V$を求めます。この章で用いる記号は、節によって変わることがあります。
# 延べ語数 N_x <- sum(freq_df_x[["freq_x"]]) N_y <- sum(freq_df_y[["freq_y"]])
## [1] 4188 ## [1] 2689
# 異なり語数 V_x <- nrow(freq_df_x) V_y <- nrow(freq_df_y)
## [1] 1261 ## [1] 1018
思いのほか総単語数に差があり問題ですが、無視して進めます。
では本の内容を進めます。
4.1 ジップの法則
ジップの法則を拡張した
$$
f_r = \frac{c}{r^a}
$$
を考えます。ここで$r$は順位、$f_r$は順位ごとの頻度です。
単語の頻度により順位付けしたデータフレームを作成ます。desc()で降順に並べ替え、min_rank(-列名)で順位を付けます。
# 頻度による順位付け freq_rank_df_x <- freq_df_x %>% dplyr::arrange(dplyr::desc(freq_x)) %>% dplyr::mutate(rank = dplyr::min_rank(-freq_x)) freq_rank_df_y <- freq_df_y %>% dplyr::arrange(dplyr::desc(freq_y)) %>% dplyr::mutate(rank = dplyr::min_rank(-freq_y)) head(freq_rank_df_x)
## # A tibble: 6 x 3 ## term freq_x rank ## <chr> <dbl> <int> ## 1 私 63 1 ## 2 こと 46 2 ## 3 こぶし 45 3 ## 4 ん 41 4 ## 5 la 40 5 ## 6 の 37 6
head(freq_rank_df_y)
## # A tibble: 6 x 3 ## term freq_y rank ## <chr> <dbl> <int> ## 1 君 43 1 ## 2 私 42 2 ## 3 の 41 3 ## 4 ん 38 4 ## 5 こと 31 5 ## 6 恋 29 6
ところで、こぶしファクトリーは困難に挑む自分に焦点をあてた曲が多く、つばきファクトリーは女の子の淡い恋心の曲が多いです。なので、こぶし(xの方)には「私」、つばき(yの方)は「私」と「君」が上位にきている点が面白いです。
対応する列を取り出し、数式の記号と合わせておきます。
# ランク r <- freq_rank_df_x[["rank"]] # 相対頻度 f_r <- freq_rank_df_x[["freq_x"]] / N_x
先ほどの式を変形して$c$を求めます。
$$
c = f_r r
$$
# 定数 c_r <- f_r * r summary(c_r)
## Min. 1st Qu. Median Mean 3rd Qu. Max. ## 0.01504 0.15473 0.15473 0.17405 0.19675 0.21132
ランクをx軸、相対頻度をy軸として散布図を作成します。
# 作図 Zipf_df <- tibble( rank = r, relative_freq = f_r ) ggplot(Zipf_df, aes(x = rank, y = relative_freq)) + geom_point() + labs(title = "Zipf's law", x = "rank", y = "relative freq")
同じことを今度は対数をとって行います。式の両辺の対数をとると
$$
\log f_r
= a \log r + \log c
$$
となることから、lm()で$a$と$\log c$を求めます。
# ランクの対数 log_r <- log(r) # 相対頻度の対数 log_f_r <- log(f_r) # Zipf-Mandelbrot法則:線形回帰 res_lm <- lm(log_f_r ~ log_r) summary(res_lm)
## ## Call: ## lm(formula = log_f_r ~ log_r) ## ## Residuals: ## Min 1Q Median 3Q Max ## -2.1976 -0.1258 -0.1258 0.1403 0.2174 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -1.999254 0.037062 -53.94 <2e-16 *** ## log_r -0.959996 0.006237 -153.91 <2e-16 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 0.1932 on 1259 degrees of freedom ## Multiple R-squared: 0.9495, Adjusted R-squared: 0.9495 ## F-statistic: 2.369e+04 on 1 and 1259 DF, p-value: < 2.2e-16
傾きをa、切片をlog_cとして、散布図に回帰直線を重ねます。
# 推定パラメータ a <- res_lm$coefficients[["log_r"]] log_c <- res_lm$coefficients[["(Intercept)"]] # 作図 Zipf_df_x <- tibble( log_f_r = log_f_r, log_r = log_r, hat_log_f_r = log_c + a * log_r ) ggplot(Zipf_df_x) + geom_point(mapping = aes(x = log_r, y = log_f_r), position = "jitter") + # 散布図 geom_line(mapping = aes(x = log_r, y = hat_log_f_r)) + # 回帰直線 labs(title = "Zipf-Mandelbrot law", x = "log rank", y = "log relative freq")
同じことをグループyに対しても行います。
# 作図 ggplot(freq_rank_df_y, aes(x = rank, y = freq_y / N_y)) + geom_point() + labs(title = "Zipf's law", x = "rank", y = "relative freq")
# ランクの対数 log_r <- log(freq_rank_df_y[["rank"]]) # 相対頻度の対数 log_f_r <- log(freq_rank_df_y[["freq_y"]] / N_y) # Zipf-Mandelbrot法則:線形回帰 res_lm <- lm(log_f_r ~ log_r) summary(res_lm)
## ## Call: ## lm(formula = log_f_r ~ log_r) ## ## Residuals: ## Min 1Q Median 3Q Max ## -1.71993 -0.08057 -0.08057 0.14374 0.18328 ## ## Coefficients: ## Estimate Std. Error t value Pr(>|t|) ## (Intercept) -2.415794 0.029270 -82.53 <2e-16 *** ## log_r -0.882085 0.005184 -170.14 <2e-16 *** ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 ## ## Residual standard error: 0.1402 on 1016 degrees of freedom ## Multiple R-squared: 0.9661, Adjusted R-squared: 0.9661 ## F-statistic: 2.895e+04 on 1 and 1016 DF, p-value: < 2.2e-16
# 推定パラメータ a <- res_lm$coefficients[["log_r"]] log_c <- res_lm$coefficients[["(Intercept)"]] # 作図 Zipf_df_y <- tibble( log_f_r = log_f_r, log_r = log_r, hat_log_f_r = log_c + a * log_r ) ggplot(Zipf_df_y) + geom_point(mapping = aes(x = log_r, y = log_f_r), position = "jitter") + # 散布図 geom_line(mapping = aes(x = log_r, y = hat_log_f_r)) + # 回帰直線 labs(title = "Zipf-Mandelbrot law", x = "log rank", y = "log relative freq")
ランクが高くなると回帰直線への当てはまりが悪い、、、ちなみに記号類を削除しないともう少し直線に近くなっていました。
4.2 語彙の豊富さ
4.2.1 延べ語数と異なり語数を用いた指標
この項では、延べ語数(総単語数)$N$と異なり語数(ユニーク単語数)$V$を用いて、語彙の豊富さを比較します。
最も簡単な指標は延べ語数に対する異なり語数の割合
$$
TTR = \frac{V}{N}
$$
で、これをトークン比(TTR)と呼びます。これは
# トークン比 TTR_x <- V_x / N_x TTR_y <- V_y / N_y TTR_x; TTR_y
## [1] 0.3010984 ## [1] 0.3785794
で計算できます。
他にも語彙の豊富さに関する指標が提案されています。それぞれやってみます。
- Guiraud(1954)の$R$
$$
R = \frac{V}{\sqrt{N}}
$$
# GuiraudのR R_x <- V_x / sqrt(N_x) R_y <- V_y / sqrt(N_y) R_x; R_y
## [1] 19.48551 ## [1] 19.63145
- Herdan(1960)の$C$
$$
C = \frac{\log V}{\log N}
$$
# HerdanのC C_x <- log(V_x) / log(N_x) C_y <- log(V_y) / log(N_y) C_x; C_y
## [1] 0.8560766 ## [1] 0.876999
- Somers(1966)の$s$
$$
s = \frac{\log(\log V)}{\log(\log N)}
$$
# Somersのs s_x <- log(log(V_x)) / log(log(N_x)) s_y <- log(log(V_y)) / log(log(N_y)) s_x; s_y
## [1] 0.9267369 ## [1] 0.9364863
- Maas(1972)の$a^2$
$$
a^2 = \frac{\log N - \log V}{\log^2 N}
$$
$\log2$って何？
# Maasのa^2 a2_x <- (log(N_x) - log(V_x)) / log(log(N_x)) a2_y <- (log(N_y) - log(V_y)) / log(log(N_y)) a2_x; a2_y
## [1] 0.5659047 ## [1] 0.4700421
- Tuldava(1978)の$LN$
$$
LN = \frac{1 - V^2}{V^2 \log N}
$$
# TudavaのLN LN_x <- (1 - V_x^2) / (V_x^2 * log(N_x)) LN_y <- (1 - V_y^2) / (V_y^2 * log(N_y)) LN_x; LN_y
## [1] -0.1199043 ## [1] -0.1266315
- Dugast(1978)の$k$
$$
k = \frac{\log V}{\log(\log N)}
$$
# Duastのk k_x <- log(V_x) / log(log(N_x)) k_y <- log(V_y) / log(log(N_y)) k_x; k_y
## [1] 3.36608 ## [1] 3.351408
- Dugast(1979)の$U$
$$
U = \frac{\log^2 N}{\log N - \log V}
$$
# DugastのU U_x <- log(log(N_x)) / (log(N_x) - log(V_x)) U_y <- log(log(N_y)) / (log(N_y) - log(V_y)) U_x; U_y
## [1] 1.767082 ## [1] 2.127469
指標の味方はよく理解していません。
4.2.2 頻度スペクトルを用いた指標
前項では、単語の豊富さに注目しました。この項では、単語が用いられている回数(頻度スペクトル)に注目します。
延べ語数を$N$、異なり語数を$V$として、テキストの中で$m$回使用された語数を$V(m, N)$とします。
count()で、同じ頻度の単語(行)数をカウントします。
# 出現頻度ごとの単語数(異なり語数)表 V_mN_df_x <- freq_df_x %>% dplyr::count(freq_x) V_mN_df_y <- freq_df_y %>% dplyr::count(freq_y) head(V_mN_df_x)
## # A tibble: 6 x 2 ## freq_x n ## <dbl> <int> ## 1 1 614 ## 2 2 236 ## 3 3 117 ## 4 4 84 ## 5 5 40 ## 6 6 30
head(V_mN_df_y)
## # A tibble: 6 x 2 ## freq_y n ## <dbl> <int> ## 1 1 563 ## 2 2 188 ## 3 3 91 ## 4 4 55 ## 5 5 25 ## 6 6 32
頻度をm、語数をv_mNとします。
# 出現頻度ベクトル m_x <- V_mN_df_x[["freq_x"]] m_y <- V_mN_df_y[["freq_y"]] # m回出現した単語数(異なり語数)ベクトル V_mN_x <- V_mN_df_x[["n"]] V_mN_y <- V_mN_df_y[["n"]] # 処理の検証 sum(m_x * V_mN_x) == N_x; sum(m_y * V_mN_y) == N_y # 延べ語数
## [1] TRUE ## [1] TRUE
sum(V_mN_x) == V_x; sum(V_mN_y) == V_y # 異なり語数
## [1] TRUE ## [1] TRUE
これを用いて、各指標を求めます。
- Yule(1944)の$K$
$$
K = 10^4
\frac{
\sum_{\mathrm{all}\ m}
m^2 V(m, N)
- N
}{
N^2
}
$$
# YuleのK K_x <- 10^4 * (sum(m_x^2 * V_mN_x) - N_x) / N_x^2 K_y <- 10^4 * (sum(m_y^2 * V_mN_y) - N_y) / N_y^2 K_x; K_y
## [1] 25.0169 ## [1] 28.86572
- Simpson(1949)の$D$
$$
D = \sum_{\mathrm{all}\ m}
V(m, N)
\frac{m}{N}
\frac{m - 1}{N - 1}
$$
# SimpsonのD D_x <- sum(V_mN_x * m_x / N_x * (m_x - 1) / (N_x - 1)) D_y <- sum(V_mN_y * m_y / N_y * (m_y - 1) / (N_y - 1)) D_x; D_y
## [1] 0.002502287 ## [1] 0.002887646
- Sichel(1975, 1986)の$S$
$$
D = \frac{V(2, N)}{V(N)}
$$
# 出現頻度が2の単語数(異なり語数) V_2N_x <- V_mN_df_x %>% dplyr::filter(freq_x == 2) %>% .[["n"]] V_2N_y <- V_mN_df_y %>% dplyr::filter(freq_y == 2) %>% .[["n"]] # SichelのS S_x <- V_2N_x / V_x S_y <- V_2N_y / V_y S_x; S_y
## [1] 0.1871531 ## [1] 0.1846758
- Honore(1979)の$H$
$$
H = 100
\frac{
\log N
}{
1 - \frac{V(1, N)}{V(N)}
}
$$
# 出現頻度が1の単語数(異なり語数) V_1N_x <- V_mN_df_x %>% dplyr::filter(freq_x == 1) %>% .[["n"]] V_1N_y <- V_mN_df_y %>% dplyr::filter(freq_y == 1) %>% .[["n"]] # HonoreのH H_x <- 100 * log(N_x) / (1 - V_1N_x / V_x) H_y <- 100 * log(N_y) / (1 - V_1N_y / V_y) H_x; H_y
## [1] 1625.458 ## [1] 1766.828
1つだけ大小関係が微妙に逆転したなぁとか思いました。
4.3 語句の重み
この節では、語句の重要度(重み)に注目します。
4.3.3 TF-IDF重み付け
文書(テキスト)数を$N$として文書のインデックスを$i = 1, 2, \cdots, N$、異なり語数を$V$として語句のインデックスを$j = 1, 2, \cdots V$とします。
- TF
文書(document)$i$において語句(term)$j$が現れた度数(freqency)を$tf_{ij}$とします。これを行方向に文書、列方向に語句として並べたマトリクスをtf_ijとします。つまり$tf_{ij}$は、tf_ij[i, j]です。
# テキストにおける語句tの頻度 tf_ij <- doc_term_mat
行数が文書数になります。
# テキストの総数 N <- nrow(tf_ij)
語句$j$を含んだ文書数を$df_j$とします。
# 語句tを含むテキストの数 df_j <- colSums(tf_ij > 0) df_j[1:10]
## [1] 5 1 1 2 4 1 2 1 1 1
- IDF
IDFは、対象となる語句がどのくらい文書に現れているかの指標です。
$$
IDF = \log \frac{N}{df}
$$
# IDF IDF_j <- log(N / df_j) round(IDF_j[1:10], 3)
## [1] 2.028 3.638 3.638 2.944 2.251 3.638 2.944 3.638 3.638 3.638
特定の文書にしか現れない場合に値が大きくなります。
- TF-IDF
TF-IDFは、TFとIDFを組み合わせた指標です。この値が大きいほど語句の重要度が高いことを表します。
$$
TF\ IDF = tf_{ij} \log \frac{N}{df_j}
$$
# TF-IDF TF_IDF_ij <- t(t(tf_ij) * IDF_j) round(TF_IDF_ij[10:19, 1:10], 3)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 10.141 0.000 0 2.944 0.000 32.738 8.833 0 3.638 0 ## [2,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [3,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [4,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [5,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [6,] 0.000 0.000 0 0.000 22.513 0.000 0.000 0 0.000 0 ## [7,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [8,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [9,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [10,] 0.000 3.638 0 0.000 0.000 0.000 0.000 0 0.000 0
以下はこれを発展させた指標になります。
- TF-IDF重み
$$
w_{ij}
= \log(tf_{ij} + 1)
\log \frac{N}{df_j}
$$
# tf_ij-IDF重み付け TFIDF_w_ij <- t(log(t(tf_ij) + 1) * IDF_j) round(TFIDF_w_ij[10:19, 1:10], 3)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 3.634 0.000 0 2.041 0.000 8.376 4.082 0 2.521 0 ## [2,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [3,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [4,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [5,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [6,] 0.000 0.000 0 0.000 5.398 0.000 0.000 0 0.000 0 ## [7,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [8,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [9,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [10,] 0.000 2.521 0 0.000 0.000 0.000 0.000 0 0.000 0
- TCF重み
$$
w_{ij}
= \frac{
tf_{ij} \log \frac{N}{df_j}
}{
\sqrt{
\sum_{j=1}^N
tf_{ij} \log \frac{N}{df_j}
}
}
$$
# TCF重み numer_ij <- t((t(tf_ij) * IDF_j)) TCF_w_ij <- numer_ij / sqrt(rowSums(numer_ij)) round(TCF_w_ij[10:19, 1:10], 3)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 0.467 0.000 0 0.136 0.000 1.507 0.407 0 0.167 0 ## [2,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [3,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [4,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [5,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [6,] 0.000 0.000 0 0.000 1.267 0.000 0.000 0 0.000 0 ## [7,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [8,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [9,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [10,] 0.000 0.154 0 0.000 0.000 0.000 0.000 0 0.000 0
- ITC重み
$$
w_{ij}
= \frac{
\log(tf_{ij} + 1)
\log \frac{N}{df_j}
}{
\sqrt{
\sum_{j=1}^N \left[
\log(tf_{ij} + 1)
\log \frac{N}{df_j}
\right]^2
}
}
$$
# ITC重み numer_ij <- t(t(log(tf_ij + 1)) * IDF_j) ITC_w_ij <- numer_ij / sqrt(rowSums(numer_ij)^2) round(ITC_w_ij[10:19, 1:10], 3)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 0.015 0.000 0 0.009 0.000 0.035 0.017 0 0.011 0 ## [2,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [3,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [4,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [5,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [6,] 0.000 0.000 0 0.000 0.039 0.000 0.000 0 0.000 0 ## [7,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [8,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [9,] 0.000 0.000 0 0.000 0.000 0.000 0.000 0 0.000 0 ## [10,] 0.000 0.011 0 0.000 0.000 0.000 0.000 0 0.000 0
4.3.4 エントロピー重み付け
- エントロピー重み
$$
w_{ij}
= \log(tf_{ij} + 1) \left\{
1
+ \frac{1}{\log N}
\sum_{i=1}^N \left[
\frac{tf_{ij}}{df_j}
\log \frac{tf_{ij}}{df_j}
\right]
\right\}
$$
# エントロピー重み付け tmp_ij <- t(t(tf_ij) / df_j) Entropy_w_ij <- t(t(log(tf_ij + 1)) * (1 + colSums(tmp_ij * log(tmp_ij + 1e-7)) / log(N))) round(Entropy_w_ij[10:19, 1:10], 3)
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 1.114 0.000 0 0.561 0.000 14.82 1.618 0 0.693 0 ## [2,] 0.000 0.000 0 0.000 0.000 0.00 0.000 0 0.000 0 ## [3,] 0.000 0.000 0 0.000 0.000 0.00 0.000 0 0.000 0 ## [4,] 0.000 0.000 0 0.000 0.000 0.00 0.000 0 0.000 0 ## [5,] 0.000 0.000 0 0.000 0.000 0.00 0.000 0 0.000 0 ## [6,] 0.000 0.000 0 0.000 3.309 0.00 0.000 0 0.000 0 ## [7,] 0.000 0.000 0 0.000 0.000 0.00 0.000 0 0.000 0 ## [8,] 0.000 0.000 0 0.000 0.000 0.00 0.000 0 0.000 0 ## [9,] 0.000 0.000 0 0.000 0.000 0.00 0.000 0 0.000 0 ## [10,] 0.000 0.693 0 0.000 0.000 0.00 0.000 0 0.000 0
続く。
参考文献
- 金明哲『テキストアナリティクス』(統計学One Point 10)共立出版,2018年.
おわりに
発売直後に購入するも2年近く積んでた本に取り組み始めました。色々浮気してますが、私はテキスト分析がしたいんです！NLPの技術自体にも勿論興味がありますが、私はハロプロ楽曲の歌詞を分析するのが目的なんです！
