見出しの分析
コーパスを作成する
corp_title <- corpus(propaganda,
text_field = "title")
# 表記を標準化する(英数字の全半角が統一する等)
texts(corp_title) <- stringi::stri_trans_nfkc(texts(corp_title))
トークン化する
toks_title <- tokens(corp_title, remove_separators = TRUE)
toks_title <- tokens_select(toks_title, "^[0-9ぁ-んァ-ヶー一-龠]+$",
valuetype = "regex", padding = TRUE)
min_count <- 10
# 漢字
kanji_col_title <- tokens_select(toks_title, "^[一-龠]+$", valuetype = "regex", padding = TRUE) %>%
textstat_collocations(min_count = min_count)
toks_title <- tokens_compound(toks_title, kanji_col_title[kanji_col_title$z > 3,], concatenator = "")
# カタカナ
kana_col_title <- tokens_select(toks_title, "^[ァ-ヶー]+$", valuetype = "regex", padding = TRUE) %>%
textstat_collocations(min_count = min_count)
toks_title <- tokens_compound(toks_title, kana_col_title[kana_col_title$z > 3,], concatenator = "")
# 漢字,カタカナおよび数字
any_col_title <- tokens_select(toks_title, "^[0-9ァ-ヶー一-龠]+$", valuetype = "regex", padding = TRUE) %>%
textstat_collocations(min_count = min_count)
toks_title <- tokens_compound(toks_title, any_col_title[any_col_title$z > 3,], concatenator = "")
文章行列を作成する
propa_title_dfm <- dfm(toks_title, remove = "")%>%
dfm_remove("^[ぁ-ん]+$", valuetype = "regex", min_nchar = 2) #ひらがなのみ&一文字の語を除去
# 頻度が高い100語を抜き出す
topwords_title <- topfeatures(propa_title_dfm, 100)
ワードクラウドを作成
set.seed(100)
textplot_wordcloud(propa_title_dfm,
min_count = 4,
rotation = 0.0,
max_size = 9,
fixed_aspect = TRUE,
random_order = FALSE,
random_color = FALSE,
color = RColorBrewer::brewer.pal(8, "Dark2"),
font = "Arial Unicode MS")

見出しに含まれる単語 上位50位を表示
# ワードリストを作成
sorted.freq.list <- sort(topwords_title, decreasing = TRUE)
par(family = "HiraKakuProN-W3")
barplot(sorted.freq.list[1 : 50],
las = 2,
cex.names = 0.6,
main = "見出しに含まれる単語 頻度上位50位",
ylab = "頻度")

共起ネットワークを作成
propa_title_fcm <-
propa_title_dfm%>%
dfm_trim(min_termfreq = 5) %>%
fcm()
feat_title <- names(topfeatures(propa_title_fcm,100))
fcm_a <- fcm_select(propa_title_fcm , pattern = feat_title)
size_a <- sqrt(rowSums(fcm_a))
textplot_network(fcm_a,
min_freq = 0.7,
vertex_size = size_a / max(size_a) * 3,
edge_alpha = 0.9, #ネットワークの濃淡を調整
vertex_labelfont = "Arial Unicode MS")

本文の分析
コーパスを作成する
corp_text <- corpus(propaganda,
text_field = "text")
texts(corp_text) <- stringi::stri_trans_nfkc(texts(corp_text)) #表記を標準化
corp_text <- corp_text %>%
#str_remove_all("見出しのみ") %>%
str_remove_all(".+と同|.+の続き") %>%
str_remove_all("【.+】")
トークン化
toks_text <- tokens(corp_text)
toks_text <- tokens_select(toks_text, "^[0-9ぁ-んァ-ヶー一-龠]+$", valuetype = "regex", padding = TRUE)
min_count <- 10
# 漢字
kanji_col_text <- tokens_select(toks_text, "^[一-龠]+$", valuetype = "regex", padding = TRUE) %>%
textstat_collocations(min_count = min_count)
toks_text <- tokens_compound(toks_text, kanji_col_text[kanji_col_text$z > 3,], concatenator = "")
# カタカナ
kana_col_text <- tokens_select(toks_text, "^[ァ-ヶー]+$", valuetype = "regex", padding = TRUE) %>%
textstat_collocations(min_count = min_count)
toks_text <- tokens_compound(toks_text, kana_col_text[kana_col_text$z > 3,], concatenator = "")
# 漢字,カタカナおよび数字
any_col_text <- tokens_select(toks_text, "^[0-9ァ-ヶー一-龠]+$", valuetype = "regex", padding = TRUE) %>%
textstat_collocations(min_count = min_count)
toks_text <- tokens_compound(toks_text, any_col_text[any_col_text$z > 3,], concatenator = "")
文章行列を作成
propa_text_dfm <- dfm(toks_text, remove = "") %>%
dfm_remove("^[ぁ-ん]+$", valuetype = "regex", min_nchar = 2)
# 頻度が高い100語を抜き出す
topwords_text <- topfeatures(propa_text_dfm, 100)
ワードクラウドを作成
min_count(登場する最小回数)を70に設定
set.seed(100)
textplot_wordcloud(propa_text_dfm,
min_count = 70,
rotation = 0.0,
max_size = 9,
fixed_aspect = TRUE,
random_order = FALSE,
random_color = FALSE,
color = RColorBrewer::brewer.pal(8, "Dark2"),
font = "Arial Unicode MS")

本文に含まれる単語 頻度上位50位を表示
# ワードリストを作成
sorted.freq.list_text <- sort(topwords_text, decreasing = TRUE)
# 頻度上位50位までを棒グラフで可視化
par(family = "HiraKakuProN-W3")
barplot(sorted.freq.list_text[1 : 50],
las = 2,
ylim = c(0,2000),
cex.names = 0.5,
main = "本文に含まれる単語 頻度上位50位",
ylab = "頻度")

共起ネットワークを作成
propa_text_fcm <- propa_text_dfm %>%
dfm_trim(min_termfreq = 5) %>%
fcm()
feat_text <- names(topfeatures(propa_text_fcm, 80))
fcm_b <- fcm_select(propa_text_fcm, pattern = feat_text)
size_b <- sqrt(rowSums(fcm_b))
textplot_network(fcm_b,
min_freq = 0.9,
vertex_size = size_b / max(size_b) * 3,
edge_alpha = 0.9, #ネットワークの濃淡を調整
vertex_labelfont = "Arial Unicode MS")
