事例: 衆議院外務委員会の議事録

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

コーパスのダウンロード

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

devtools::install_github("quanteda/quanteda.corpora")

## Warning: `install_github()` was deprecated in devtools 2.5.0.
## ℹ Please use pak::pak("user/repo") instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

## 
## ── R CMD build ─────────────────────────────────────────────────────────────────
## * checking for file ‘/private/var/folders/rs/y2dgxlys0cs4xcxxdnnxhyj80000gn/T/RtmpwRPJrO/remotes13000395c1c3/quanteda-quanteda.corpora-5259da4/DESCRIPTION’ ... OK
## * preparing ‘quanteda.corpora’:
## * checking DESCRIPTION meta-information ... OK
## Warning: bad markup (extra space?) at data_corpus_irishbudgets.Rd:31:2
## Warning: /private/var/folders/rs/y2dgxlys0cs4xcxxdnnxhyj80000gn/T/Rtmpe7nLGj/Rbuild1303e23762020/quanteda.corpora/man/data_corpus_irishbudgets.Rd:32: unexpected section header '\keyword'
## Warning: /private/var/folders/rs/y2dgxlys0cs4xcxxdnnxhyj80000gn/T/Rtmpe7nLGj/Rbuild1303e23762020/quanteda.corpora/man/data_corpus_irishbudgets.Rd:33: unexpected END_OF_INPUT '
## '
## * checking for LF line-endings in source and make files and shell scripts
## * checking for empty or unneeded directories
## Removed empty directory ‘quanteda.corpora/sources’
## Warning: bad markup (extra space?) at data_corpus_irishbudgets.Rd:31:2
## Warning: /private/var/folders/rs/y2dgxlys0cs4xcxxdnnxhyj80000gn/T/Rtmpe7nLGj/Rbuild1303e23762020/quanteda.corpora/man/data_corpus_irishbudgets.Rd:32: unexpected section header '\keyword'
## Warning: /private/var/folders/rs/y2dgxlys0cs4xcxxdnnxhyj80000gn/T/Rtmpe7nLGj/Rbuild1303e23762020/quanteda.corpora/man/data_corpus_irishbudgets.Rd:33: unexpected END_OF_INPUT '
## '
## * building ‘quanteda.corpora_0.9.3.tar.gz’

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

コーパスの作成手順

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

議事録をダウンロード

国会会議録のダウンロードには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"))

コーパスの作成

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

議事録の数と期間を取得

ndoc(full_corp)

## [1] 287298

range(docvars(full_corp, "date"))

## [1] "1947-06-30" "2017-11-29"

前処理

発言者のいないレコード（典型的には各議事録の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)))

capacity	Freq
Other	17174
会計検査院当局者	47
会計検査院説明員	5
会計検査院長	7
公述人	70
内閣官房副長官	260
副大臣	3020
参事	8
参考人	11600
参考人（通訳つき	8
参考人（通訳なし	2
君	233
大臣	52850
大臣政務官	1135
委員	172692
委員外務大臣	1
委員大臣	2
委員長	24685
委員長代理	1361
政府特別補佐人	80
議員	27

docvars(full_corp, "capacity") <- capacity

1991から2010年までの期間の議事録を選択

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

ndoc(corp)

## [1] 62670

委員，大臣，副大臣の発言を選択

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

## [1] 46890

トークン化

日本語の分析では，形態素解析ツールを用いて分かち書きを行うことが多いが，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 = "")

文書行列の作成

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)

分析

相対頻度分析

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

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

feature	chi2	n_target	n_reference
武正委員	462.8233	662	0
東門委員	444.2879	647	3
笠井委員	428.5473	613	0
アフガニスタン	360.4991	582	18
グアム	350.8133	561	16
防衛省	340.4229	487	0
小泉総理	339.0242	485	0
近藤	333.5359	481	1
中曽根国務大臣	328.5346	470	0
町村国務大臣	323.6395	463	0
赤嶺委員	318.2806	500	12
民主党	298.5617	678	77
岡田国務大臣	298.4658	427	0
軽減	298.3167	666	73
首藤委員	290.7970	435	5
政務官	290.2955	438	6
小野寺委員	283.7818	406	0
密約	268.3716	463	22
麻生大臣	260.7082	373	0
財務省	219.5688	318	1

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

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

	feature	chi2	n_target	n_reference
4	アフガニスタン	360.4991	582	18
5	グアム	350.8133	561	16
6	防衛省	340.4229	487	0
7	小泉総理	339.0242	485	0
8	近藤	333.5359	481	1
12	民主党	298.5617	678	77
14	軽減	298.3167	666	73
16	政務官	290.2955	438	6
18	密約	268.3716	463	22
20	財務省	219.5688	318	1
23	ロードマップ	207.6848	301	1
27	米軍再編	199.1851	285	0
28	普天間	198.0009	514	74
29	山口	185.5153	439	54
30	負担軽減	184.2305	275	3
31	辺野古	183.5319	274	3
32	日米同盟	182.6724	376	34
33	金子	180.4233	262	1
34	六カ国協議	175.5304	255	1
37	六者協議	161.3439	281	14

共起ネットワーク分析

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)

トピックモデル

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

set.seed(100)
lda <- LDA(convert(speech_dfm, to = "topicmodels"), k = 10)
get_terms(lda, 10) |> knitr::kable()

Topic 1	Topic 2	Topic 3	Topic 4	Topic 5	Topic 6	Topic 7	Topic 8	Topic 9	Topic 10
インドネシア	繁栄	前向き	両国間	租税条約	大きい	準備	イラン	国内法	定義
関与	計上	配慮	同様	防止	前回	地雷	漁業	行使	詰め
自身	輸出	法案	促進	ミャンマー	意義	旅券	何度	沖縄県民	人道的
資金	エネルギー	センター	資する	相手国	採択	ポト派	安保条約	過程	局長
常任理事国	果たす	生活	業務	課税	出席	アフガニスタン	部隊	日米関係	入札
ミャンマー	採択	教育	一層	所得	関係者	部隊	会合	地方	背景
再開	二国間	難民	提案理由	国内法	専門家	核実験	自身	禁止	首脳会談
イニシアチブ	構築	禁止	日本国	回避	に対し	イギリス	一生懸命	本条約	信頼
ドル	図る	建設	開始	租税	警察	写真	在日米軍	真剣	普天間
要素	加盟	全力	ベトナム	経過	人権	武装解除	区域	不安	来る

get_topics(lda) |> table() |> barplot(xlab = "Topic", ylab = "Frequency")

Kohei Watanabe and Akitaka Matsuo