からっぽのしょこ

読んだら書く!書いたら読む!同じ事は二度調べ(たく)ない

【R】2.1:トピックモデルの文書集合の作成【青トピックモデルのノート】

はじめに

 『トピックモデル』(MLPシリーズ)の勉強会資料のまとめです。各種モデルやアルゴリズムを「数式」と「プログラム」を用いて解説します。
 本の補助として読んでください。

 この記事では、MeCabを利用して各種モデルによる推論用の頻度データをR言語で作成します。

【前節の内容】

www.anarchive-beta.com

【他の節の内容】

www.anarchive-beta.com

【この節の内容】

2.1 トピックモデルの文書集合の作成

 RMeCabパッケージを利用してテキストファイルから、トピックモデルなどの各種モデルで用いるbag-of-words表現の文書データ(文書と語彙ごとの頻度データ)を作成する。
 文書集合については「2.1:トピックモデルの文書表現【青トピックモデルのノート】 - からっぽのしょこ」、真の分布(パラメータ類)を設定して生成モデルに従う簡易的な文書データ(トイデータ)を作成する場合は「各種モデルの生成モデルの実装」を参照のこと。

 利用するパッケージを読み込む。

# 利用パッケージ
library(RMeCab)
library(tidyverse)

 この記事では、基本的に パッケージ名::関数名() の記法を使うので、パッケージの読み込みは不要である。ただし、作図コードについてはパッケージ名を省略するので、ggplot2 を読み込む必要がある。
 また、ネイティブパイプ演算子 |> を使う。magrittrパッケージのパイプ演算子 %>% に置き換えられるが、その場合は magrittr を読み込む必要がある。

文字コードの変換

 まずは、MeCabはUTF-8のテキストファイルしか扱えないので、Shift-JISなどの場合は文字コードを変換しておく必要がある。

 テキストファイルの文字コードをShift-JISからUTF-8に変換する。

# 変換前のフォルダパスを指定
dir_path_jis <- "data/text_jis"

# 変換後のフォルダパスを指定
dir_path <- "data/text"

# ファイル名を取得
file_name_vec <- list.files(path = dir_path_jis)

# 文書ごとに文字コードを変換
for(i in 1:length(file_name_vec)) {
  
  # ファイルを読込
  df <- read.csv(
    file = paste(dir_path_jis, file_name_vec[i], sep = "/"), # 読み込みファイルパス
    fileEncoding = "cp932", 
    header = FALSE
  )
  
  # ファイルを書出
  write.table(
    x = df, 
    file = paste(dir_path, file_name_vec[i], sep = "/"), # 書き出しファイルパス
    fileEncoding = "utf8", 
    quote = FALSE, row.names = FALSE, col.names = FALSE
  )
}

 read.csv()fileEncoding 引数に元の文字コードを指定してテキストファイルを読み込み、write.table()fileEncoding 引数に変換する文字コード(UTF-8)を指定してテキストファイルとして書き出す。

文書データの整形

 次は、テキストデータの前処理を行い文書集合と頻度データを作成する。この記事では、(正確には異なる単位だが)形態素を語彙として扱う。

語順を記録しない場合

 トピックモデルでは単語が出現した順番は考慮しないので、こちらの方法では、語順の情報を記録(文書集合を作成)せずに語彙ごとの頻度の情報に整形する。作成したbag-of-words表現の文書データからは元の文章を再現できない。

 フォルダを指定して、形態素解析を行う。

# フォルダパスを指定
dir_path <- "data/text"

# 文書数を設定
D <- list.files(path = dir_path) |> 
  length()

# 形態素解析と頻度を集計
mecab_df <- RMeCab::docDF(target = dir_path, type = 1) |> 
  tibble::as_tibble() |> 
  magrittr::set_colnames(c("TERM", "POS1", "POS2", paste0("V", 1:D))) # 列名を文書番号に変更
mecab_df
# A tibble: 1,461 × 25
   TERM  POS1  POS2     V1    V2    V3    V4    V5    V6    V7    V8    V9   V10
   <chr> <chr> <chr> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
 1 '     名詞  サ変…     0     0     0     0     0     0     0     0     0     0
 2 (     名詞  サ変…     7     0     2     0     2     8    10     3     3     0
 3 )     名詞  サ変…     6     0     2     0     2     8     5     3     3     0
 4 )…    名詞  サ変…     1     0     0     0     0     0     0     0     0     0
 5 )「   名詞  サ変…     0     0     0     0     0     0     3     0     0     0
 6 1     名詞  数        0     0     0     1     0     0     0     0     0     0
 7 100   名詞  数        0     0     0     0     1     0     0     0     0     0
 8 119   名詞  数        0     0     0     0     0     0     0     0     0     0
 9 4     名詞  数        2     0     0     0     0     0     0     0     0     0
10 8     名詞  数        0     0     0     0     0     0     0     0     0     0
# ℹ 1,451 more rows
# ℹ 12 more variables: V11 <int>, V12 <int>, V13 <int>, V14 <int>, V15 <int>,
#   V16 <int>, V17 <int>, V18 <int>, V19 <int>, V20 <int>, V21 <int>, V22 <int>

 (テキストファイルのみが保存されている)フォルダパスを指定して、フォルダ内のテキスト(文書)の形態素解析と語彙の出現頻度(出現回数)の集計を行う。docDF() の分割形式の引数 type1 を指定して文章を形態素(語彙)ごとに分割する。
 TERM 列に語彙(の原形)、POS1 列に品詞大分類、POS2 列に品詞細分類、その他の列にそれぞれの文書における頻度を格納したデータフレームが出力される。
 ファイル名が列名になるので、集計や可視化の処理用に、通し番号(文書番号)の列名にしておく。

 集計(分析)に用いる語彙を設定する。

# 抽出する品詞を指定
pos1_vec <- c("名詞", "形容詞", "動詞", "感動詞") # 大分類
pos2_vec <- c("一般", "代名詞", "ナイ形容詞語幹", "形容動詞語幹", "副詞可能", "サ変接続","自立") # 細分類

# 除去する文字列を指定
stop_word_vec <- c("(", ")", "<", ">", "ー")

# 合計頻度の下限を指定
lower_total_freq <- 3

# 分析用の語彙を抽出
freq_wide_df <- mecab_df |> 
  dplyr::filter(POS1 %in% pos1_vec) |> # 品詞を抽出
  dplyr::filter(POS2 %in% pos2_vec) |> # 品詞を抽出
  dplyr::filter(!(TERM %in% stop_word_vec)) |> # ストップワードを除去
  dplyr::reframe(dplyr::across(dplyr::starts_with("V")), .by = TERM) |> # 別品詞の頻度を合計
  dplyr::rowwise() |> # 行和の計算用
  dplyr::mutate(
    total = sum(dplyr::c_across(dplyr::starts_with("V"))), .before = 2 # 別文書の頻度を合計
  ) |> 
  dplyr::ungroup() |> 
  dplyr::filter(total >= lower_total_freq) |> # 低頻度語を除去 |> 
  dplyr::mutate(
    v = dplyr::row_number(), .before = 1 # 語彙番号
  )
freq_wide_df
# A tibble: 250 × 25
       v TERM  total    V1    V2    V3    V4    V5    V6    V7    V8    V9   V10
   <int> <chr> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
 1     1 '         4     0     0     0     0     0     0     0     0     0     0
 2     2 )「       3     0     0     0     0     0     0     3     0     0     0
 3     3 AH        6     0     0     0     0     0     0     0     0     0     0
 4     4 Baby      8     0     0     0     0     0     0     6     0     0     0
 5     5 GO        3     0     0     0     0     0     0     0     0     0     0
 6     6 Go       11     0     0     8     0     0     0     0     0     0     0
 7     7 I         7     0     0     0     0     0     0     0     0     0     0
 8     8 Just      3     0     0     0     0     0     0     0     0     0     0
 9     9 Keep      3     0     0     0     0     0     0     0     0     0     0
10    10 Live      4     0     0     0     0     0     0     0     0     0     0
# ℹ 240 more rows
# ℹ 12 more variables: V11 <int>, V12 <int>, V13 <int>, V14 <int>, V15 <int>,
#   V16 <int>, V17 <int>, V18 <int>, V19 <int>, V20 <int>, V21 <int>, V22 <int>

 品詞(大分類・小分類)を指定して語彙(行)を抽出する。%in% 演算子の左側に対象のベクトル(列)、右側に条件(パターン)のベクトルを指定すると、マッチする要素(行)を抽出できる。
 文書(列)ごとに品詞の異なる同じ文字列の語彙の頻度の和を求める。across()starts_with() を使って、頻度列(列名が V から始まる列)の和を計算できる。
 語彙(行)ごとに全ての文書(列)の頻度の和を求めて、全文書での出現回数が少ない語彙(行)を除去する。rowwise()c_across() を使って、語彙(行)ごとに頻度列の和を計算できる。
 その他必要に応じて、ストップワードや記号の除去などの前処理を行う。

 bag-of-words表現の文書データ(頻度データ)のマトリクスを作成する。

# 文書ごとの各語彙の出現回数を作成
N_dv <- freq_wide_df |> 
  dplyr::select(!c(v, TERM, total)) |> # 頻度列を取得
  t() # 行と列を入替・マトリクスに変換
dimnames(N_dv) <- NULL # 列名・行名を削除
N_dv[1:10, 1:10]
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0    0    0    0    0    0    0    0     0
 [2,]    0    0    0    0    0    0    0    0    0     0
 [3,]    0    0    0    0    0    8    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    0    0    0    0    0     0
 [7,]    0    3    0    6    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    0    0    0    0    0    0    0    0     0

 各文書の頻度列を取り出して、行が文書、列が語彙に対応するように転置する。t() で転置する際にマトリクスに変換される。

 magrittrパッケージのパイプ演算子を使うと次のように処理できる。

# 一部でmagrittrパイプ演算子を使う場合
N_dv <- mecab_df |> 
  dplyr::filter(POS1 %in% pos1_vec) |> # 品詞を抽出
  dplyr::filter(POS2 %in% pos2_vec) |> # 品詞を抽出
  dplyr::filter(!(TERM %in% stop_word_vec)) |> # ストップワードを除去
  dplyr::reframe(dplyr::across(dplyr::starts_with("V")), .by = TERM) |> # 別品詞の頻度を合計
  dplyr::select(!TERM) %>% # 頻度列を取得
  dplyr::filter(rowSums(.) >= lower_total_freq) |> # 低頻度語を除去
  t() # 行と列を入替・マトリクスに変換
dimnames(N_dv) <- NULL # 列名・行名を削除
N_dv[1:10, 1:10]
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    0    0    0    0    0    0    0    0    0     0
 [2,]    0    0    0    0    0    0    0    0    0     0
 [3,]    0    0    0    0    0    8    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    0    0    0    0    0     0
 [7,]    0    3    0    6    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    0    0    0    0    0    0    0    0     0

 magrittrパイプのプレースホルダ . は、ネイティブパイプのプレースホルダ _ よりも柔軟に処理できる。

 各文書の単語数のベクトルを作成する。

# 各文書の単語数を集計
N_d <- rowSums(N_dv)
N_d
 [1]  80  70  86  34  90  77 118  66  65  48 112  79  77  54  98  79  77  88  61
[20]  42  58  89

 各文書の単語数  (N_1, \cdots, N_D) は、それぞれの文書の全ての語彙の出現回数の和で計算できる。

 \displaystyle
N_d
    = \sum_{v=1}^V N_{dv}

 文書集合に関する値を取得する。

# 文書数を取得
D <- nrow(N_dv)
D <- length(N_d)

# 語彙数を取得
V <- ncol(N_dv)

# 全文書の単語数を取得
N <- sum(N_dv)
N <- sum(N_d)
D; V; N
[1] 22
[1] 250
[1] 1648

 文書数  DN_dv の行数または N_d の要素数、語彙数  VN_dv の列数に対応する。
 全文書の単語数(総単語数)  N は、全ての文書の単語数の和で計算できる。

 \displaystyle
N   = \sum_{d=1}^D N_d
    = \sum_{d=1}^D \sum_{v=1}^V N_{dv}


 トピックモデルにおける推論処理では単語ごとに計算を行うので、(実際の出現順や意味の通る語順である必要はないが)単語番号と語彙番号の対応関係の情報を用いる。そこで、ランダムに語順を決めて(重複を含む語彙番号を並べ替えて)、単語番号を指定すると対応する語彙番号を得られるオブジェクトを作成しておく。

 頻度データのマトリクスから、分析用の(元のデータとは異なる)文書集合のリストを作成する。

# リストを初期化
w_lt <- list()

# 文書ごとに単語集合を作成
for(d in 1:D) {
  
  # 語彙の出現フラグを作成
  flag_vec <- N_dv[d, ] > 0
  
  # 語彙番号を作成
  v_vec <- mapply(
    FUN = \(v, n) {rep(v, times = n)}, 
    (1:V)[flag_vec], 
    N_dv[d, flag_vec]
  ) |> 
    unlist()
  
  # 語彙番号を割当
  w_n <- sample(x = v_vec, size = N_d[d], replace = FALSE) # 単語集合
  
  # 単語集合を格納
  w_lt[[d]] <- w_n
}
head(w_lt, n = 3)
[[1]]
 [1]  57  28  43 103  31  40 130  85  57  50  28 121  84 172 202 103  40  47  50
[20]  81 239  46  34 202 202  47  40  34  68  40  84  57 146  40 196  46  25 196
[39] 177  84 172  81  85 225 144  34  47  86  42  40  40  28  81  69  34 103  25
[58]  57  34  92  85  85  14  81 185  42  16 155 166  40 103  40  34  86 121  92
[77]  92  84 159  92

[[2]]
 [1]  41  57  41  78  72 111  69 132  46 181  70 143  57 190  79 129  60 145  60
[20]  67 210 129 227 190  72 171  53 148  41 126  93 234  64 132 111  70  72  41
[39]  46  93 144 232  67 111 181 109 109 173  78 109  60  79 207 179 210 129  79
[58]  46 234  57 171  78  53  41  72 191  79 179  57  53

[[3]]
 [1]  41  62   6 241 112 238 140 140  62   6 120 140  16  16   6  16 222 139 162
[20]  43 174 241 140 241 241 112  57  69  16 140  16 210 183  57 241  25 169 162
[39]  69 179 140 179 183   6  25  41 140 203   6  25 162 162 229 241   6 175  16
[58] 210   6  25 183  16  69 183 210  62  25  25 237  62 241  57  25 140 113  37
[77]  69 221 241  16 188  25  81  69   6  37

 文書と語彙ごとの頻度データ N_dv を用いて、D 個のベクトルを格納した文書集合のリストを作成する。各ベクトルは、N_d[d] 個の語彙番号を格納した単語集合のベクトルである。文書ごとに単語数が異なるので、データフレームやマトリクスでは扱えない。
 文書(行)ごとに、語彙番号(列インデックス)を単語数(要素の値)個に複製して、ランダムに番号(要素)を入れ替える。mapply() を使って、語彙番号 1:V と各語彙の単語数 N_dv[d, ] のベクトルの要素ごとに処理できる。各要素の処理結果が格納されたリストが出力されるので、unlist() でベクトルに変換する。

 単語を指定して語彙を取り出せる。

# 文書番号・単語番号を指定
d <- 3
n <- 5

# 語彙を抽出
v      <- w_lt[[d]][n]
v_term <- freq_wide_df[v, "TERM"] |> 
  unlist(use.names = FALSE)
v; v_term
[1] 112
[1] "人生"

 文書集合のリスト w_lt に対して、文書番号をリストのインデックス、単語番号をベクトルのインデックスとして用いると、指定した単語の語彙番号が得られる。
 語彙番号と語彙の文字列の対応関係は freq_wide_df から得られる。

 文書集合のリストから、各文書の単語数のベクトルを作成する。

# 各文書の単語数を取得
N_d <- lapply(w_lt, FUN = length) |> 
  unlist()

# 全文書の単語数を取得
N <- sum(N_d)
N_d; N
 [1]  80  70  86  34  90  77 118  66  65  48 112  79  77  54  98  79  77  88  61
[20]  42  58  89
[1] 1648

 単語集合のベクトル w_lt[[d]] の要素数が単語数に対応する。lapply() を使って、リストに格納された要素ごとに処理できる。

語順を記録する場合

 こちらの方法では、可視化時などに利用できる形で単語の出現順(語順)を別のオブジェクトに保存しておき、語彙ごとの頻度の情報に整形する。

 ファイルを指定して、形態素解析を行う。

# フォルダパスを指定
dir_path <- "data/text"

# ファイルパスを取得
file_path_vec <- list.files(path = dir_path) |> # ファイル名を取得
  (\(vec) {paste(dir_path, vec, sep = "/")})() # ファイルパスを作成

# 文書数を取得
D <- length(file_path_vec)

# リストを初期化
mecab_lt <- list()

# 文書ごとにテキストデータを整形
for(d in 1:D) {
  
  # 形態素解析
  res_lt <- RMeCab::RMeCabText(file_path_vec[d])
  
  # 結果を抽出
  tmp_df <- tibble::tibble(
    term = lapply(res_lt, FUN = \(vec){vec[1]}) |> 
      unlist(), 
    TERM = lapply(res_lt, FUN = \(vec){vec[8]}) |> 
      unlist(), 
    POS1 = lapply(res_lt, FUN = \(vec){vec[2]}) |> 
      unlist(), 
    POS2 = lapply(res_lt, FUN = \(vec){vec[3]}) |> 
      unlist()
  ) |> 
    dplyr::mutate(
      TERM = dplyr::if_else(TERM == "*", true = term, false = TERM)
    ) |> # (英語などの)原形状態がない場合は活用状態に置換
    dplyr::select(TERM, POS1, POS2) # 不要な列を削除
  
  # 結果を格納
  mecab_lt[[d]] <- tmp_df
}
head(res_lt); mecab_lt[[D]]
[[1]]
 [1] "Vivid"    "名詞"     "固有名詞" "組織"     "*"        "*"       
 [7] "*"        "*"        ""         ""        

[[2]]
 [1] "Midnight" "名詞"     "一般"     "*"        "*"        "*"       
 [7] "*"        "*"        ""         ""        

[[3]]
 [1] "…"   "記号" "一般" "*"    "*"    "*"    "*"    "…"   "…"   "…"  

[[4]]
 [1] "ビビっ"     "動詞"       "自立"       "*"          "*"         
 [6] "五段・ラ行" "連用タ接続" "ビビる"     "ビビッ"     "ビビッ"    

[[5]]
 [1] "と"     "助詞"   "格助詞" "引用"   "*"      "*"      "*"      "と"    
 [9] "ト"     "ト"    

[[6]]
 [1] "し"         "動詞"       "自立"       "*"          "*"         
 [6] "サ変・スル" "連用形"     "する"       "シ"         "シ"        
# A tibble: 360 × 3
   TERM     POS1   POS2    
   <chr>    <chr>  <chr>   
 1 Vivid    名詞   固有名詞
 2 Midnight 名詞   一般    
 3 …        記号   一般    
 4 ビビる   動詞   自立    
 5 と       助詞   格助詞  
 6 する     動詞   自立    
 7 たい     助動詞 *       
 8 Midnight 名詞   固有名詞
 9 自信     名詞   一般    
10 も       助詞   係助詞  
# ℹ 350 more rows

 (テキストファイルのみが保存されている)フォルダパスを指定して、フォルダ内のテキスト(文書)のファイルパスを作成する。
 1ファイルずつ順番に RMeCabText() で文章を順番を保ったまま形態素(語彙)ごとに分割する。単語ごとの情報がそれぞれベクトルに格納され、全ての単語のベクトルが格納されたリストが出力される。
 各ベクトルの 1 番目の要素に文書中での活用形の語彙、8 番目の要素に原形の語彙、2 番目の要素に品詞大分類、3 番目の要素に品詞小分類が格納される。ただし、英語などの場合は原型が格納されない( 8 番目の要素が * になる)。
 文書ごとに TERM 列に語彙の原型、POS1 列に品詞大分類、POS2 列に品詞細分類を格納したデータフレームを作成して、全ての文書のデータフレームをリストに格納していく。ただし、原形の情報がない場合は活用した形の語彙を格納する。lapply()FUN 引数に処理を指定して、リストに格納された要素ごとに処理できる。

 集計(分析)に用いる語彙を設定する。

# 抽出する品詞を指定
pos1_vec <- c("名詞", "形容詞", "動詞", "感動詞") # 大分類
pos2_vec <- c("一般", "代名詞", "ナイ形容詞語幹", "形容動詞語幹", "副詞可能", "サ変接続","自立") # 細分類

# 除去する文字列を指定
stop_word_vec <- c("(", ")", "<", ">", "ー")

# 合計頻度の下限を指定
lower_total_freq <- 3

# 分析用の語彙を抽出
vocab_df <- mecab_lt |> 
  dplyr::bind_rows() |> # 全文書を結合
  dplyr::filter(POS1 %in% pos1_vec) |> # 品詞を抽出
  dplyr::filter(POS2 %in% pos2_vec) |> # 品詞を抽出
  dplyr::filter(!(TERM %in% stop_word_vec)) |> # ストップワードを除去
  dplyr::summarise(
    total = dplyr::n(), .by = TERM # 別品詞・別文書の頻度を集計
  ) |> 
  dplyr::filter(total >= lower_total_freq) |> # 低頻度語を除去
  dplyr::mutate(
    v = dplyr::row_number(), .before = 1 # 語彙番号
  )
vocab_df
# A tibble: 250 × 3
       v TERM                 total
   <int> <chr>                <int>
 1     1 Ready                    9
 2     2 to                       7
 3     3 イケイケ                 4
 4     4 イケ                     4
 5     5 ーメケメケフィーバー     4
 6     6 あばれる                 9
 7     7 ハヴアグッタイ           4
 8     8 ここ                    11
 9     9 いる                    18
10    10 我慢                     3
# ℹ 240 more rows

 分かち書きした文書データのリスト mecab_lt に格納した全ての文書のデータフレームを行方向に結合する。
 品詞(大分類・小分類)を指定して語彙(行)を抽出する。%in% 演算子の左側に対象のベクトル(列)、右側に条件(パターン)のベクトルを指定すると、マッチする要素(行)を抽出できる。
 語彙ごとに全ての文書の頻度の和を求めて、文書全体での出現回数が少ない語彙(行)を除去する。summarise()n() を使って、語彙ごとの頻度(行数)を集計できる。
 その他必要に応じて、ストップワードや記号の除去などの前処理を行う。

 こちらの方法だと、文書データ全体で出現した順に語彙番号が割り振られる。

 中間オブジェクトとして、単語集合のデータフレームを格納した文書集合のリストを作成する。

# 文書集合を作成
word_lt <- mecab_lt |> 
  lapply(
    FUN = \(df) {
      df |> 
        dplyr::filter(POS1 %in% pos1_vec) |> # 品詞を抽出
        dplyr::filter(POS2 %in% pos2_vec) |> # 品詞を抽出
        dplyr::inner_join(vocab_df, by = "TERM") |> # 語彙番号を結合
        dplyr::mutate(
          n = dplyr::row_number() # 単語番号
        ) |> 
        dplyr::select(n, v, TERM)
    }
  )
word_lt[[D]]
# A tibble: 89 × 3
       n     v TERM  
   <int> <int> <chr> 
 1     1   245 ビビる
 2     2    11 する  
 3     3    69 自信  
 4     4   237 ほしい
 5     5    17 キリ  
 6     6    18 ない  
 7     7   245 ビビる
 8     8   246 綺羅星
 9     9   247 冴える
10    10   219 '     
# ℹ 79 more rows

 mecab_lt の各文書データから語彙の設定時と同様に語彙を抽出し、集計用の語彙データ vocab_df から対応する語彙番号を結合して、単語番号を追加する。

 単語集合のベクトルを格納した文書集合のリストを作成する。

# 文書集合を作成
w_lt <- word_lt |> 
  lapply(
    FUN = \(df){df[["v"]]} # 単語集合を格納
  )
tail(w_lt, n = 3)
[[1]]
 [1]  45 207  77  88 176 170 191 130  52 192 137  47 243  11 210 136 117  21  11
[20]  90 233 207 197  36 230 191 128  26  89 176  47  85 243  11  52 192  18  11
[39] 243  11 243  11

[[2]]
 [1] 177 244 244 119  96 244 244 130  67  47 127  95  26  74  11 107 166 244 244
[20] 119 136 211 244 244 238 160  91  11 215 167 101 140  11  91 116 156 244 244
[39] 119 115 211 244 244 133  77 100  11  74 244 244 119 136 211 244 244 238 160
[58]  91

[[3]]
 [1] 245  11  69 237  17  18 245 246 247 219 134 129  35 134 157  11  68 112 248
[20] 245  11  69 237  17  18 249 249 249 245  11  69 237  17  18  29 172  37  18
[39] 165 198  52 219  48 137 157  11 218  51 112  31 248 250 250 245 246 247 249
[58] 249 245 246 247  95  29 166  21  29  95  95  95  29 157  11 218  51 112  31
[77] 248 250 250 245 246 247 249 249 245 246 247  95  29

 単語番号と語彙番号の対応データ word_lt から、文書(データフレーム)ごとに、語彙番号列をベクトルとしてリストに格納する。

 単語を指定して語彙を取り出せる。

# 文書番号・単語番号を指定
d <- D
n <- 7

# 語彙を抽出
v      <- w_lt[[D]][n]
v_term <- vocab_df[v, "TERM"] |> 
  unlist(use.names = FALSE)
v; v_term
[1] 245
[1] "ビビる"

 語彙番号と語彙の文字列の対応関係は freq_wide_df から得られる。

 bag-of-words表現の文書データ(頻度データ)のマトリクスを作成する。

# 文書ごとの各語彙の出現回数を作成
N_dv <- word_lt |> 
  lapply(
    FUN = \(df) {
      df |> 
        dplyr::summarise(
          freq = dplyr::n(), .by = v # 頻度を集計
        ) |> 
        dplyr::right_join(vocab_df, by = "v") |> # 語彙情報に頻度情報を結合
        dplyr::mutate(
          freq = dplyr::if_else(is.na(freq), true = 0, false = freq) # 未出現語を頻度0に置換
        ) |> 
        dplyr::arrange(v) |> # 列の結合用
        dplyr::pull(freq) # 頻度列を取得
    }
  ) |> 
  dplyr::bind_cols(.name_repair = ~paste0("V", 1:D)) |> # 全文書の頻度列を結合
  t() # 行と列を入替・マトリクスに変換
dimnames(N_dv) <- NULL # 列名・行名を削除
N_dv[1:10, 1:10]
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
 [1,]    1    1    4    4    4    9    4    2    2     2
 [2,]    0    0    0    0    0    0    0    0    3     0
 [3,]    8    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    1    1     0
 [6,]    0    0    0    0    0    0    0    2    2     0
 [7,]    0    0    0    0    0    0    0    3    0     0
 [8,]    0    0    0    0    0    0    0    0    0     0
 [9,]    0    0    0    0    0    0    0    2    6     0
[10,]    0    0    0    0    0    0    0    0    0     0

 word_lt から文書(データフレーム)ごとに、語彙(語彙番号列の値)ごとの頻度(行数)を集計して、集計用の語彙データ vocab_df に対応する頻度を結合する。文書に含まれない語彙は頻度が欠損値になるので 0 に置き換える。
 全ての語彙と(頻度0を含む)頻度の対応データフレームになるので、全ての文書の頻度列を列方向に結合して、行が文書、列が語彙に対応するように転置する。t() で転置する際にマトリクスに変換される。

 各文書の単語数のベクトルを作成する。

# 各文書の単語数を集計
N_d <- rowSums(N_dv)
N_d
 [1]  80  70  86  34  90  77 118  66  65  48 112  79  77  54  98  79  77  88  61
[20]  42  58  89


 文書集合に関する値を取得する。

# 文書数を取得
D <- nrow(N_dv)

# 語彙数を取得
V <- ncol(N_dv)

# 全文書の単語数を取得
N <- sum(N_dv)
D; V; N
[1] 22
[1] 250
[1] 1648


 以上の2つの方法で、テキストデータから、単語集合のベクトル w_n を格納した文書集合のリスト w_lt と、bag-of-words表現の文書データ(文書と語彙の頻度データ)のマトリクス N_dv を作成した。「各種推論アルゴリズムの実装」では N_dv を用いてパラメータ類の推論を行う。

データの可視化

 最後は、作成した文書データのグラフを作成する。

文書データの図

 頻度データのデータフレームを作成する。

# 文書と頻度ごとの頻度データを格納
freq_long_df <- N_dv |> 
  t() |> # 行と列を入替
  tibble::as_tibble(.name_repair = ~paste0("V", 1:D)) |> # 文書番号の列名を設定
  dplyr::mutate(
    v    = 1:V, # 語彙番号
    TERM = vocab_df[["TERM"]], 
    .before = 1
  ) |> # 語彙情報を追加
  tidyr::pivot_longer(
    cols         = !c(v, TERM), 
    names_to     = "d", 
    names_prefix = "V", 
    names_transform = list(d = as.numeric), 
    values_to    = "freq"
  ) |> # 語彙ごとの頻度列をまとめる
  dplyr::select(d, v, TERM, freq) |> # 確認用
  dplyr::arrange(d, v) # 確認用
freq_long_df
# A tibble: 5,500 × 4
       d     v TERM                  freq
   <dbl> <int> <chr>                <dbl>
 1     1     1 Ready                    1
 2     1     2 to                       1
 3     1     3 イケイケ                 4
 4     1     4 イケ                     4
 5     1     5 ーメケメケフィーバー     4
 6     1     6 あばれる                 9
 7     1     7 ハヴアグッタイ           4
 8     1     8 ここ                     2
 9     1     9 いる                     2
10     1    10 我慢                     2
# ℹ 5,490 more rows

 文書と語彙ごとの頻度データ N_dv の行と列を入れ替えて、頻度列を並べたデータフレームを作成して、(マトリクスの作成時に削除した)語彙情報を追加する。
 pivot_longer() で頻度列を1列にまとめて、列名を文書番号に変換する。

 文書ごとに語彙の出現回数のグラフを作成する。

# ラベル用の文字列を作成
doc_df <- tibble::tibble(
  d     = 1:D, 
  max_n = N_d
)
data_label <- paste0(
  "list(", 
  "D == ", D, ", ", 
  "V == ", V, ", ", 
  "N == ", N, 
  ")"
)

# 文書ごとの頻度を作図
ggplot() + 
  geom_bar(data = freq_long_df, 
           mapping = aes(x = v, y = freq, fill = factor(v)), 
           stat = "identity") + # 頻度
  geom_label(data = doc_df, 
             mapping = aes(x = -Inf, y = Inf, label = paste("N[d] ==", max_n)), 
             parse = TRUE, hjust = 0, vjust = 1, alpha = 0.5) + # 各文書の単語数
  facet_wrap(. ~ d, labeller = label_bquote(document~(d): .(d))) + # グラフを分割
  guides(fill = "none") + # 凡例の体裁
  labs(title = "document set", 
       subtitle = parse(text = data_label), 
       x = expression(vocabulary~(v)), 
       y = expression(frequency~(N[dv])))

文書ごとの各語彙の頻度(bag-of-words表現の文書データ)

 「語順を記録する場合」の方法だと、文書データ全体で出現した順に語彙番号が割り振られるので、文書番号が小さいほど山が左に偏っている。

 全文書での出現回数に応じて順位付けする。

# 表示語数を指定
lower_rank <- 25

# 順位を集計
rank_df <- freq_long_df |> 
  dplyr::summarise(
    total = sum(freq), .by = c(v, TERM) # 総頻度を計算
  ) |> 
  dplyr::mutate(
    rank = dplyr::row_number(-total) # 順位付け
  ) |> 
  dplyr::filter(rank <= lower_rank) |> # 上位を抽出
  dplyr::mutate(
    rev_rank = dplyr::row_number(-rank) # (反転表示用)逆順の順位付け
  ) |> 
  dplyr::arrange(rank) # 確認用
rank_df
# A tibble: 25 × 5
       v TERM  total  rank rev_rank
   <int> <chr> <dbl> <int>    <int>
 1    11 する     64     1       25
 2    41 君       42     2       24
 3    42 私       31     3       23
 4    18 ない     30     4       22
 5    22 wow      30     5       21
 6    95 愛       29     6       20
 7    51 なる     26     7       19
 8    47 ある     20     8       18
 9    74 夢       19     9       17
10   173 ON       19    10       16
# ℹ 15 more rows

 語彙ごとに頻度の和を求めて、合計頻度の降順に通し番号を割り当て、指定した語数分の行を取り出す。
 y座標の値として、逆順の順位列を追加する。

 全文書での高頻度語彙のグラフを作成する。

# 全文書での出現頻度を作図
ggplot() + 
  geom_bar(data = rank_df, 
           mapping = aes(x = reorder(x = paste0(TERM, " (", v, ")"), X = rev_rank), y = total, fill = factor(v)), 
           stat = "identity") + # 合計頻度
  geom_text(data = rank_df, 
            mapping = aes(x = rev_rank, y = 0, label = paste(" ", total)), 
            hjust = 0, size = 3) + # 合計頻度
  scale_y_continuous(sec.axis = sec_axis(trans = ~.)) + # 頻度軸の第2軸を追加
  coord_flip() + # 軸を入替
  guides(fill = "none") + # 凡例の体裁
  labs(title = "document data", 
       subtitle = parse(text = data_label), 
       x = expression(vocabulary~(v)), 
       y = expression(frequency~(N[v])))

データ全体でよく出現した語彙

 棒グラフのみであれば reorder() に順位列 rank を使った方がシンプルに作図できる。他の geom_***() を重ねるのであれば逆順位列 rev_rank を使った方がシンプルに作図できる。

 文書ごとに出現回数に応じて順位付けする。

# 表示語数を指定
lower_rank <- 10

# 文書ごとの
rank_df <- freq_long_df |> 
  dplyr::mutate(
    rank = dplyr::row_number(-freq), .by = d # 順位付け
  ) |> 
  dplyr::filter(rank <= lower_rank) |> # 上位を抽出
  dplyr::mutate(
    rev_rank = dplyr::row_number(-rank), # 逆順の順位付け
    reorder  = (d-1)*lower_rank + rev_rank, # (反転表示用)プロット位置
    .by = d
  ) |> 
  dplyr::arrange(reorder) # 確認用
rank_df
# A tibble: 220 × 7
       d     v TERM                  freq  rank rev_rank reorder
   <dbl> <int> <chr>                <dbl> <int>    <int>   <dbl>
 1     1    13 うち                     3    10        1       1
 2     1    12 現代                     3     9        2       2
 3     1    14 やる                     4     8        3       3
 4     1    11 する                     4     7        4       4
 5     1     7 ハヴアグッタイ           4     6        5       5
 6     1     5 ーメケメケフィーバー     4     5        6       6
 7     1     4 イケ                     4     4        7       7
 8     1     3 イケイケ                 4     3        8       8
 9     1    22 wow                      6     2        9       9
10     1     6 あばれる                 9     1       10      10
# ℹ 210 more rows

 文書ごとに、頻度の降順に通し番号を割り当て、指定した語数分の行を取り出す。
 y座標の値として、文書1から順番に lower_rank 語ずつ降順に並べたときの通し番号を reorder 列とする。

 各文書の高頻度語彙のグラフを作成する。

# 文書ごとの出現頻度を作図
ggplot() + 
  geom_bar(data = rank_df, 
           mapping = aes(x = reorder, y = freq, fill = factor(v)), 
           stat = "identity") + # 頻度
  geom_text(data = rank_df,
            mapping = aes(x = reorder, y = 0, label = paste(" ", freq)),
            hjust = 0, size = 3) + # 頻度
  geom_label(data = doc_df, 
             mapping = aes(x = Inf, y = Inf, label = paste("N[d] ==", max_n)), 
             parse = TRUE, hjust = 1, vjust = 1, alpha = 0.5) + # 各文書の単語数
  facet_wrap(. ~ d, scales = "free_y", labeller = label_bquote(document~(d): .(d))) + # グラフを分割
  scale_x_continuous(breaks = rank_df[["reorder"]], 
                     labels = paste0(rank_df[["TERM"]], " (", rank_df[["v"]], ")")) + # 語彙軸目盛ラベルを設定
  coord_flip() + # 軸を入替
  guides(fill = "none") + # 凡例の体裁
  labs(title = "document data", 
       subtitle = parse(text = data_label), 
       x = expression(vocabulary~(v)), 
       y = expression(frequency~(N[dv])))

各文書でよく出現した語彙

 fracet_***() でグラフを分割する場合、reorder() はデータ全体に対して入れ替えるので(?)、分割したグラフごとの並べ替えにならない。そこで、データ全体での並び順(通し番号)列 reorder を作成しておく。
 他に、tidytextパッケージ reorder_within()scale_y_reordered() を使う方法もある(メモ)。

 ストップワードを含めた単語情報を作成する。

# 描画する文書数を指定
doc_num <- 9

# 単語の列数を指定
col_num <- 20

# 文書ごとに単語情報を作成
word_df <- tibble::tibble()
for(d in 1:doc_num) {
  
  # プロット位置を計算
  tmp_df <- mecab_lt[[d]] |> 
    dplyr::left_join(
      vocab_df |> 
        dplyr::select(v, TERM), 
      by = "TERM"
    ) |> # 語彙番号を結合
    dplyr::mutate(
      d = d, # 文書番号
      v = dplyr::if_else(POS1 %in% pos1_vec, true = v, false = NA), # 別品詞の語彙番号を除去
      v = dplyr::if_else(POS2 %in% pos2_vec, true = v, false = NA), # 別品詞の語彙番号を除去
      n = dplyr::if_else(!is.na(v), true = cumsum(!is.na(v)), false = NA), # 単語番号
      i = dplyr::row_number(),   # 座標の計算用
      r = (i-1) %/% col_num + 1, # x座標
      c = (i-1) %% col_num + 1   # y座標
    )
  
  # 単語情報を結合
  word_df <- dplyr::bind_rows(word_df, tmp_df)
}

# 単語の行数を取得
row_num <- max(word_df[["r"]])
word_df
# A tibble: 2,837 × 9
   TERM  POS1  POS2         v     d     n     i     r     c
   <chr> <chr> <chr>    <int> <int> <int> <int> <dbl> <dbl>
 1 Feel  名詞  固有名詞    NA     1    NA     1     1     1
 2 Your  名詞  一般        NA     1    NA     2     1     2
 3 FUNK  名詞  一般        NA     1    NA     3     1     3
 4 !    記号  一般        NA     1    NA     4     1     4
 5 Are   名詞  固有名詞    NA     1    NA     5     1     5
 6 You   名詞  一般        NA     1    NA     6     1     6
 7 Ready 名詞  一般         1     1     1     7     1     7
 8 to    名詞  一般         2     1     2     8     1     8
 9 FUNK  名詞  一般        NA     1    NA     9     1     9
10 !    記号  一般        NA     1    NA    10     1    10
# ℹ 2,827 more rows

 分かち書きした文書データのリスト mecab_lt の全ての単語に対して、集計用の語彙データ vocab_df から語彙番号を結合する。品詞の異なる同じ文字列の単語に対して語彙番号が結合されるので、ストップワードとして除去した( vocab_df に含まれない)単語の番号を欠損値にする。
 集計用に抽出した(語彙番号が欠損値でない)単語に対して通し番号を割り当てて、抽出した語彙の単語番号を再現する。
 ストップワードを含めた全ての単語に対して通し番号を割り当てて、単語のプロット位置を計算する。

 文書ごとに単語を並べたグラフを作成する。

# ラベル用の文字列を作成
doc_df <- tibble::tibble(
  d     = 1:doc_num, 
  max_n = N_d[d], 
  upper_n = word_df |> 
    dplyr::filter(i == max(i), .by = d) |> # 語数を抽出
    dplyr::pull(i)
)

# 単語情報を作図
ggplot() + 
  geom_tile(data = word_df, 
            mapping = aes(x = c, y = r, fill = factor(POS1)), 
            alpha = 0.2) + # 語彙情報
  geom_text(data = word_df, 
            mapping = aes(x = c, y = r, label = TERM, color = factor(v))) + # 語彙ラベル
  geom_label(data = doc_df, 
             mapping = aes(x = Inf, y = Inf, label = paste("N[d] ==", max_n, "~(", upper_n, ")")), 
             parse = TRUE, hjust = 1, vjust = 0, alpha = 0.5) + # 各文書の単語数
  scale_x_continuous(minor_breaks = NULL) + 
  scale_y_reverse(minor_breaks = NULL) + 
  facet_wrap(. ~ d, labeller = label_bquote(document~(d): .(d))) + # グラフを分割
  guides(color = "none") + # 凡例の体裁
  labs(title = "document data", 
       subtitle = parse(text = data_label), 
       fill = "part of speech", 
       x = "", y = "")

元の文書データ(文章)

 ここでは、文字列を語彙番号、セルを品詞に応じて配色している。グレー色の単語は、ストップワードとして削除された語彙を表す。各グラフの右下のラベルは、抽出した(分析に用いる)語彙の単語数であり、丸括弧の値は除去した(分析に用いない)語彙も含めた数である。
 推論結果などの可視化では、トピックごとに色付けするなどして各文書の特徴を見る。

 この記事では、各種モデルに対応した文書データをテキストファイルから作成した。次の記事では、ユニグラムモデルで用いる記号や定義を確認します。

参考書籍

  • 岩田具治(2015)『トピックモデル』(機械学習プロフェッショナルシリーズ)講談社
  • Juice=Juice(2018)『Juice=Juice#2 -¡Una más!-』(CD)アップフロントワークス

おわりに

 トイデータ作りをモデルごとに実装してるので、生データの集計も一応やっておくことにしました。あくまでアルゴリズムの理解のためのスクラッチ実装であって、生データを使う(分析する)つもりはないんだけどなぁ。

 元々は自然言語処理をするために勉強を始めたのですが、MeCabを触るは本当に久しぶりです。どれくらいぶりかというと、PCにMeCabは入っていたものの、現在使っているバージョンのR用にはRMeCabパッケージが入っていませんでした。最後に使った記憶もありません。

 軽い気持ちで書き始めたので当初は、頻度の集計データの作成と、表4.2に対応する図に再利用できる頻度の図の作成の2本立てのつもりで書き始めました。ところが筆がノって、語順を残す処理を書き足し、語順情報があるならと図2.1の図を作り、その完成図を見たら物足りなくて削除した語も含めた図(白本の図2.2)にアップデートしました。
 いいリハビリになりましたが、想定の数倍の時間がかかりました。そろそろ数式読解編と実装編の修正作業に取り組みます。

 2024年4月20日は、OCHA NORMAの石栗奏美の20歳のお誕生日です!

 バラエティができるタイプのハロメンなので早くお茶の間さまに見つかってほしいー。

【次節の内容】

  • 数式読解編

www.anarchive-beta.com


  • スクラッチ実装編

 ユニグラムモデルの生成モデルをプログラムで確認します。

www.anarchive-beta.com