In quanteda/quanteda: Quantitative Analysis of Textual Data

knitr::opts_chunk$set(
  collapse = FALSE,
  comment = "##"
)

library(quanteda)
library(stringr)
library(dplyr)
library(lubridate)
library(topicmodels)

コーパスのダウンロード {#download}

本例で用いる衆議院外務委員会の議事録は，1947年から2017年の間のすべての発言を含んでいる．このコーパスはquanteda.corporaを用いてダウンロードできる．

devtools::install_github("quanteda/quanteda.corpora")
full_corp <- quanteda.corpora::download("data_corpus_foreignaffairscommittee")

コーパスの作成手順 {#how-to-make-corpus}

読者が独自のコーパスを作成できるように，本例のコーパスを作成した手順を以下に示してある．

議事録をダウンロード {#download-speeches}

国会会議録のダウンロードにはkaigirokuパッケージを使う．APIが応答しない場合に途中からダウンロードをやり直す必要がないように，年ごとにファイルに保存し，それらを最後に連結すると良い．

devtools::install_github("amatsuo/kaigiroku")
library(kaigiroku)

# 年ごとに議事録をダウンロード
folder_download <- "~/temp/download"
committee <- "外務"

for (year in 1947:2017) {
  cat(as.character(Sys.time()), year, committee, "\n")
  temp <- get_meeting(meetingName = committee, year = year)
  if (is.null(temp)) next
  saveRDS(temp, file = sprintf("%s/%s_%s.rds", folder_download, year, committee))
  Sys.sleep(10)
}

# ファイルを結合して保存
file_all <- list.files(folder_download, full = TRUE, pattern = ".rds")
speech <- lapply(as.list(file_all), readRDS) |> bind_rows()
saveRDS(speech, file = paste0(folder_download, "committee_speeches.rds"))

コーパスの作成 {#create-corpus}

load("temp/committee_speeches.rda")
full_corp <- corpus(foreign_affairs_committee_speeches, text_field = "speech")

議事録の数と期間を取得 {#number-of-speeches}

ndoc(full_corp)
range(docvars(full_corp, "date"))

前処理 {#pre-processing}

発言者のいないレコード（典型的には各議事録の0番目の出席者，議題等の部分）を取り除く，また，各発言の冒頭は発言者の氏名と役職名なので，その部分から役職名を取り出して新しいdocvarを作る．

full_corp <- corpus_subset(full_corp, speaker != "")

## capacity変数の作成
capacity <- full_corp |>
  str_sub(1, 20) |>
  str_replace_all("\\s+.+|\n", "") |> # 冒頭の名前部分の取り出し
  str_replace( "^.+?(参事|政府特別補佐人|内閣官房|会計検査院|最高裁判所長官代理者|主査|議員|副?大臣|副?議長|委員|参考人|分科員|公述人|君(（.+）)?$)", "\\1") |> # 冒頭の○から，名前部分までを消去
  str_replace("（.+）", "")
capacity <- str_replace(capacity, "^○.+", "Other") # マイナーな役職名は一括して"Other"に
knitr::kable(as.data.frame(table(capacity)))

docvars(full_corp, "capacity") <- capacity

1991から2010年までの期間の議事録を選択 {#select-speeches-1991-2010}

docvars(full_corp, "year") <- docvars(full_corp, "date") |> year() |> as.numeric()
corp <- corpus_subset(full_corp, 1991 <= year & year <= 2010)

ndoc(corp)

委員，大臣，副大臣の発言を選択 {#select-speeches-ministers}

corp <- corpus_subset(corp, capacity %in% c("委員", "大臣", "副大臣"))
ndoc(corp)

トークン化 {#tokenization}

日本語の分析では，形態素解析ツールを用いて分かち書きを行うことが多いが，quantedaのtokens()は，ICUで定義された規則に従って文を語に分割することができる．さらに，漢字やカタカナの連続的共起をtextstat_collocations()を用いて抽出し，tokens_compound()によって統計的に優位な組み合わせを結合すると，より質の高いトークン化を実現できる．textstat_collocations()を用いる場合は，事前にtokens_select()と正規表現で，対象とする語だけを選択する．この際，padding = TRUEとし，語の間の距離が維持されるように注意する

toks <- tokens(corp)
toks <- tokens_select(toks, "^[０-９ぁ-んァ-ヶー一-龠]+$", valuetype = "regex", padding = TRUE)
toks <- tokens_remove(toks, c("御", "君"), padding = TRUE)

min_count <- 10

# 漢字
library("quanteda.textstats")
kanji_col <- tokens_select(toks, "^[一-龠]+$", valuetype = "regex", padding = TRUE) |> 
             textstat_collocations(min_count = min_count)
toks <- tokens_compound(toks, kanji_col[kanji_col$z > 3,], concatenator = "")

# カタカナ
kana_col <- tokens_select(toks, "^[ァ-ヶー]+$", valuetype = "regex", padding = TRUE) |> 
            textstat_collocations(min_count = min_count)
toks <- tokens_compound(toks, kana_col[kana_col$z > 3,], concatenator = "")

# 漢字，カタカナおよび数字
any_col <- tokens_select(toks, "^[０-９ァ-ヶー一-龠]+$", valuetype = "regex", padding = TRUE) |> 
           textstat_collocations(min_count = min_count)
toks <- tokens_compound(toks, any_col[any_col$z > 3,], concatenator = "")

文書行列の作成 {#create-dfm}

dfm()によって文書行列を作成した後でも，dfm_*()と命名された関数を用いると分析に必要な文書の特徴を自由に選択できる．ここでは，平仮名のみもしくは一語のみから構成されたトークンをdfm_remove()によって，頻度が極端に低い語もしくは高い語をdfm_trim()によって削除している．

speech_dfm <- dfm(toks) |>
    dfm_remove("") |> 
    dfm_remove("^[ぁ-ん]+$", valuetype = "regex", min_nchar = 2) |> 
    dfm_trim(min_termfreq = 0.50, termfreq_type = "quantile", max_termfreq = 0.99)

分析 {#analysis}

相対頻度分析 {#keyness}

textstat_keyness()は語の頻度を文書のグループ間で比較し，統計的に有意に頻度が高いものを選択する．ここでは，同時多発テロが発生した2001年以降に頻度が高くなった30語を示してある．

key <- textstat_keyness(speech_dfm, docvars(speech_dfm, "year") >= 2001)
head(key, 20) |> knitr::kable()

上の表では，委員会出席者の名前が多く含まれるので，それらを取り除くと議論の主題が明確になる．

key <- key[!str_detect(key$feature, regex("委員|大臣")),]
head(key, 20) |> knitr::kable()

共起ネットワーク分析 {#network}

fcm()によって作成した共起行列に対して，textplot_network()を用いると語の関係が視覚化でき，文書の内容の全体像を容易に把握できる．

library("quanteda.textplots")
feat <- head(key$feature, 50)
speech_fcm <- dfm_select(speech_dfm, feat) |> fcm()
size <- sqrt(rowSums(speech_fcm))
textplot_network(speech_fcm, min_freq = 0.85, edge_alpha = 0.9, 
                 vertex_size = size / max(size) * 3,
                 vertex_labelfont = if (Sys.info()["sysname"] == "Darwin") "SimHei" else NULL)

トピックモデル {#topicmodel}

quantedaのdfmをconvert()で変換し，topicmodelsをパッケージを用いて潜在的な話題を推定する．

set.seed(100)
lda <- LDA(convert(speech_dfm, to = "topicmodels"), k = 10)
get_terms(lda, 10) |> knitr::kable()
get_topics(lda) |> table() |> barplot(xlab = "Topic", ylab = "Frequency") 

quanteda/quanteda documentation built on Sept. 4, 2024, 7:56 p.m.