主題敘述

透過自然語言處理(Natural Language Processing, NLP)，比較蔡英文總統在2016與2017的演講的常用字有何不同。

Pre-setting

library(jiebaR)  # 為了斷詞，裡面有一堆中文詞庫
library(tidyverse)
library(ggplot2)
options(stringsAsFactors = F)

Load data

# jiebaR的用法
cutter <- worker()  # 從jibaR裡來的
segment_not <- c("蔡英文", "南向政策", "副總統")  # 不在詞庫裡，但不希望被斷開的字
new_user_word(cutter, segment_not)  # 加成功就是TRUE
## [1] TRUE
# tokenized to files
cutted2016 <- cutter['tsai_speech/tsai_speech_2016.txt']  
cutted2017 <- cutter['tsai_speech/tsai_speech_2017.txt']

word2016 <- unlist(strsplit(readLines(cutted2016, encoding="UTF-8"), "\\s"))
# readLines: 讀檔，之後遇到空白就斷掉，之後unlist掉
word2017 <- unlist(strsplit(readLines(cutted2017, encoding="UTF-8"), "\\s"))
# word2016 = unlist(read.table(cutted2016))
# word2017 = unlist(read.table(cutted2017))

# print(sprintf("%s", tail(word2016, n=20)))
# print(sprintf("%s", tail(word2017, n=20)))

speech <- rbind(data.frame(word=word2016, year='y2016'), 
                # 兩個column，第一個叫word，裡面放2016斷詞後的結果，第二個叫year，裡面放"y2016"
    data.frame(word=word2017, year='y2017'))
rownames(speech) <- NULL

Read stopwords

fin <- file("tsai_speech/stopwords_tw.txt",open="r")
stopWords <- readLines(fin, encoding="UTF-8")
stopWords <- unique(stopWords)
added <- c("ㄟ")  
reserved <- c("我們")  #可以自己再看裡面有沒有要保留的
stopWords <- setdiff(stopWords, reserved)  #把要保留的拿掉
stopWords <- union(stopWords, added)   # 把不要的加進去
# length(stopWords)
# [1] 1205

計算字出現的頻率

library(stringr)
word_count <- speech %>%
  filter(!is.na(word)) %>%
  count(year, word, sort = TRUE) %>%
  ungroup() %>%
  filter(!str_detect(word, "[a-zA-Z0-9]+")) %>%
  filter(!(word %in% stopWords)) %>%
  mutate(word = str_replace_all(word, "台灣", "臺灣")) %>%   # 把所有的「台灣」取代成「臺灣」
  mutate(word = str_replace_all(word, "台灣人", "臺灣人"))

視覺化：用字頻率差異（頻率相減）

此圖為兩年用字頻率直接相減所得到的差異，從圖可發現相較於2017年，2016年蔡英文的演講主要強調新政府上任、他們的抱負與對未來的期望等，並且使用「我們」、「國家」、「社會」、「臺灣」等強調聯合眾人的字，整體用字偏向光明正向；而相較於2016年，2017年的用字則沒有那麼正面，多了許多檢討過去一年執政的字眼（如「不夠」、「不當」、「困難」、「去年」等），並用了「蔡英文」、「團隊」等強調執政者的字，與2016年強調聯合眾人的字有顯著的不同。

# 計算用字頻率差異（頻率相減）
difference_2016_2017 <- word_count %>%
  filter(sum(n) >= 5) %>%   
  spread(year, n, fill = 0) %>%  
  # 要把2016跟2017分開
  # 根據year，產生新的variable
  # spread會把2016、2017各自拉成一個variable，從long form變成table。
  # 如果要用t-test看不一樣的裝置有沒有差異，應該要用本來普通的long form。
  # fill = 0 表示如果有沒有出現的字的話，就填0。
  # 如果fill = NA的話則會填NA。
  ungroup() %>%
  mutate(minor = y2016 - y2017) %>% #算出不同裝置的差異(2016年字出現的頻率減掉2017年)
  arrange(desc(minor))

# 視覺化
difference_2016_2017 %>%
  group_by(minor > 0) %>%
  top_n(20, abs(minor)) %>%  # 依據minor絕對值，各選20個，也就是兩邊最兩極化的
  ungroup() %>%
  mutate(word = reorder(word, minor)) %>%  # reorder必做
  ggplot(aes(word, minor, fill = minor < 0)) +  # 如果minor > 0，顏色會翻轉
  geom_bar(stat = "identity") +
  coord_flip() +
  ylab("y2016 - y2017") +
  theme(axis.text.y=element_text(colour="black")) +
  scale_fill_manual(name = "", labels = c("2016", "2017"),
                    values = c("red", "lightblue"))   # 可指定顏色(用標準html的顏色名稱)

視覺化：用字頻率差異（勝算比）

此圖使用勝算比來比較兩年的用字差異，與上張圖的計算方式不一樣，但同樣是能夠比較用字差異的方法。圖的結果與上張圖不完全相同，但大致而言差異不大：相較於2017年，2016年的用字大多偏向正面，強調團結、未來的願景；而相較於2016年，2017年則多了許多檢討過去一年施政結果的字眼。

# 計算用字頻率差異（勝算比）
ratios_2016_2017 <- word_count %>%
  filter(sum(n) >= 5) %>%
  spread(year, n, fill = 0) %>%
  ungroup() %>%
  mutate_each(funs((. + 1) / sum(. + 1)), -word) %>%  
  # 勝算比(odds ratio)，可估狗「勝算比、相對機率」
  # 「.」表示前面算出來的 ，+1是為了避免取到log0
  mutate(logratio = log2(y2016 / y2017)) %>%
  arrange(desc(logratio))

# 畫圖
ratios_2016_2017 %>%
  group_by(logratio > 0) %>%
  top_n(15, abs(logratio)) %>%
  ungroup() %>%
  mutate(word = reorder(word, logratio)) %>%
  ggplot(aes(word, logratio, fill = logratio < 0)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  ylab("2016 / 2017 log ratio") +
  theme(axis.text.y=element_text(colour="black")) +
  scale_fill_manual(name = "", labels = c("2016", "2017"),
                    values = c("red", "lightblue"))

視覺化：wordcloud

此圖以文字雲直接呈現兩年蔡英文演講中常用的字，能夠直接的了解兩年演講中最常出現的字，但若要比較兩年的用字差異，可能則不如前兩張長條圖的呈現方式。仔細比較兩張圖的差異，可以發現如上面兩張圖的結果。

library(wordcloud)
library(RColorBrewer)

word_count_2016 <- as.data.frame(word_count[word_count$year %in% "y2016", ]) 
word_count_2017 <- as.data.frame(word_count[word_count$year %in% "y2017", ]) 

# 顏色
pal <- brewer.pal(9, "BuGn")[-(1:4)]
pal2 <- brewer.pal(9, "Reds")[-(1:4)]

# 找顏色
# brewer.pal.info
# display.brewer.all()

# 畫文字雲
par(mfrow=c(1,2))
wordcloud(words = word_count_2016$word, freq = word_count_2016$n, min.freq = 3,
          random.order = F, colors = pal)
title(main="2016", cex.main = 1)

wordcloud(words = word_count_2017$word, freq = word_count_2017$n, min.freq = 3,
          random.order = F, colors = pal2)
title(main="2017", cex.main = 1)