社群媒體分析 - PTT八卦版:川普的討論分析
Group 9 徐湛 郭宗翰 蔡柏毅
2020/4/28
動機與分析目的
新冠肺炎爆發迄今，美國總統川普對於中國政府與疫情的態度，從稱讚與樂觀轉為批評。我們想探討從2/10川普樂觀表示疫情四月會轉好，到美國疫情大爆發，再到目前對WHO與中國政府的批評的這段時間內，PTT鄉民對於川普觀感與討論的內容。
前置作業
資料來源
使用的資料是由中山大學管理學院文字分析平台取得，在平台下載原始資料之csv檔
資料簡介
資料內容為2020/02/10到2020/04/26，PTT八卦版之文章，透過文字分析平台以「川普」、「特朗普」與「Trump」為關鍵字，搜尋到的916篇文章
Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼## [1] ""library(stringr)
library(wordcloud2)
library(ggplot2)
library(jiebaR)
library(tidyr)
library(dplyr)
library(scales)
library(data.table)
library(tidytext)
library(widyr)
library(igraph)
library(ggraph)
library(reshape2)
library(readr)1. Preprocessing
1.1 讀取資料，並且將英文單字替換為中文
trump_csv <- fread("trump3.csv", encoding = "UTF-8", header = TRUE)
trump_csv$artDate = trump_csv$artDate %>% as.Date("%Y/%m/%d")
trump_csv <- na.omit(trump_csv)
trump_csv$artContent <- gsub(c("virus", "VIRUS"), "病毒", trump_csv$artContent)
trump_csv$artContent <- gsub(c("trump", "donald", "realdonaldtrump"), "川普", trump_csv$artContent)
trump_csv$artContent <- gsub(c("who", "WHO"), "世界衛生組織", trump_csv$artContent)
trump_csv$artContent <- gsub(c("covid", "COVID"), "新冠肺炎", trump_csv$artContent)
head(trump_csv)## artTitle artDate artTime
## 1: [新聞]川普稱：疫情4月會消失 2020-02-10 14:03:51
## 2: Re:[新聞]川普稱：疫情4月會消失 2020-02-10 19:10:17
## 3: Re:[新聞]川普稱：疫情4月會消失 2020-02-10 19:43:15
## 4: [爆卦]川普提案將美國對WHO的金援砍半 2020-02-11 15:44:04
## 5: [新聞]川普鐵口直斷：四月疫情緩解 2020-02-12 04:04:21
## 6: [問卦]川普蓋牆的觀念是不是很先進? 2020-02-12 19:22:09
## artUrl
## 1: https://www.ptt.cc/bbs/Gossiping/M.1581372600.A.FAF.html
## 2: https://www.ptt.cc/bbs/Gossiping/M.1581390980.A.221.html
## 3: https://www.ptt.cc/bbs/Gossiping/M.1581392958.A.6A6.html
## 4: https://www.ptt.cc/bbs/Gossiping/M.1581465006.A.C07.html
## 5: https://www.ptt.cc/bbs/Gossiping/M.1581509424.A.F25.html
## 6: https://www.ptt.cc/bbs/Gossiping/M.1581564491.A.316.html
## artContent
## 1: 1.媒體來源:三立新聞網__2.記者署名:中央社華盛頓10日電__3.完整新聞標題:武漢肺炎／「高溫會殺死病毒」 川普稱：疫情4月會消失__4.完整新聞內文:__（中央社華盛頓10日電）美國總統川普今天表示，他預期已造成900多人病亡的新型冠狀_病毒疫情會在4月份消失，因為屆時天氣會趨暖。__川普說，「病毒…一般會在4月份消失」；並說，「大致上，高氣溫會殺死這類病毒」。__類似嚴重急性呼吸道症候群（SARS）的這種病原體自去年底在中國形成疫情後，至今已使_大約4萬人感染，美國出現了12起嚴重程度不同的確診病例。__5.完整新聞連結 (或短網址):_https://www.setn.com/News.aspx?NewsID=687194_6.備註:_川大大跟習大大從疫情爆發開始後 時不時的 熱線你和我_連天氣這種鬼話都說得出口...__恩...._
## 2: 現在會不會有一堆大媽聽川普隊長的話__ 出國前往現在氣溫比較高的國家玩?__ 川普這席話應該是有所本吧__
## 3: 川普最近的發言都和美國政府作為反著幹的_之前說做的很好，結果撤僑__現在更耐人尋味的說_「病毒_一般_會在4月消失」_「_大致上_，高氣溫會殺死這類病毒。」__潛台詞就是_「如果沒消失，代表這病毒_不一般_」_「如果高溫殺不死，說明這病毒_並非_這_類病毒_。」__再加上最近的人造病毒傳聞_很有事先鋪梗的意味_PTT_opia
## 4: https://tinyurl.com/yx34k34b_川普2021預算案昨天剛推出，砍了很多免費仔的經費__其中最爽的：WHO經費將砍半__難怪最近WHO這個基八組織比較乖_不過美國國會好像不同意這個編法__心得：我川就是狂__
## 5: 1.媒體來源:__聯合報__2.記者署名__季晶晶__3.完整新聞標題:__川普鐵口直斷：四月疫情緩解__4.完整新聞內文:__美國有線電視新聞網（CNN）報導，美國總統川普重申，他相信等到換季氣溫升高時，新_冠肺炎（武漢肺炎）疫情可以緩解，儘管專家學者都認為現在做此認定還為時太早。__川普十日在白宮對各州州長演說時提及，他上周和大陸國家主席習近平通電話時談到氣溫_一事。川普引述習近平的評估表示：「一般來說，高溫能殺死這種病毒。」__川普說：「那會是一件好事。」稍早川普說，「很多人認為四月轉暖就沒事了」。__川普上周曾在推特提出新冠肺炎和天氣轉暖之間的理論。但傳染病專家後來都表示，現在_斷言天氣轉暖可能削弱病毒威力還太早。__德州貝勒醫學院熱帶醫藥學院主任霍德茲說：「假設情況會在春夏兩季平靜下來過於輕率_。我們並不了解這個季節說法的根據，目前我們對這種特定病毒絕對是一無所知。」__5.完整新聞連結 (或短網址):_https://udn.com/news/story/120944/4337947_6.備註:_
## 6: 美國爸爸的大統領 - 川普，競選時最重要的政見就是蓋牆，__把非法移民通通隔離在墨西哥，當時台灣一堆人都在嘲笑川普，__左派的人一直狂噴川普沒有人權，種族歧視。__結果武漢肺炎 aka 新冠肺炎-19 一爆發，台灣人馬上能夠感受到美國人的痛苦，__幸好台灣跟中國還隔著台灣海峽，不然就會跟美國一樣，__一堆小明直接從國境從墨西哥偷渡進入美國，__不知道當初酸川普蓋牆的左派人權鬥士，現在一樣支持小明到台灣嗎?__還是人權只有跟自己無關的時候才重要?_日期折線圖
呈現每日討論熱度
trump_date <- trump_csv %>%
select(artDate, artUrl) %>%
distinct()
article_count_by_date <- trump_date %>%
group_by(artDate) %>%
summarise(count = n())
article_count_by_date %>%
arrange(desc(count))%>%
top_n(10)## Selecting by count## # A tibble: 10 x 2
## artDate count
## <date> <int>
## 1 2020-03-20 53
## 2 2020-03-17 36
## 3 2020-03-13 33
## 4 2020-03-12 30
## 5 2020-03-24 30
## 6 2020-03-19 28
## 7 2020-04-15 28
## 8 2020-03-18 27
## 9 2020-03-22 27
## 10 2020-03-14 25討論篇數最多的10天
date_plot <- article_count_by_date %>%
ggplot(aes(x = artDate, y = count)) +
geom_line(color = "blue", size = 1.5) +
geom_vline(xintercept = c(as.numeric(as.Date("2020-03-20")),
as.numeric(as.Date("2020-03-17")),
as.numeric(as.Date("2020-03-13")),
as.numeric(as.Date("2020-04-15")),
as.numeric(as.Date("2020-02-27")),
as.numeric(as.Date("2020-03-06")),
as.numeric(as.Date("2020-03-24"))), col='red', size = 1) +
scale_x_date(labels = date_format("%Y/%m/%d")) +
ggtitle("「川普」討論文章數") +
xlab("日期") +
ylab("數量")
date_plot
PTT八卦版上，有關川普的討論在03/20, 03/17, 03/13, 03/24, 04/15出現高峰，而3月前討論的高峰出現在02/27，03/06則是進入討論高峰前的轉折
03/20 [新聞]川普堅持「正名」中國！演講稿寫冠狀病
03/17 [新聞]很故意！川普再發「中國病毒」推文
03/13 [新聞]快訊／才剛見川普吃晚餐…巴西總統發言人
03/24 [新聞]美2.7萬確診全球第4川普轟「中國的錯」
04/15 [新聞]川普斷WHO金援！比爾蓋茲警告：很危險
03/06 [爆卦]川普說得武漢肺炎可以去工作! 02/27 [新聞]川普信心喊話 別太怕新冠肺炎「當流感就好
1.2 斷詞與去除停用詞
jieba_tokenizer <- worker(user="user_dict.txt", stop_word = "stop_words.txt")
t_tokenizer <- function(t) {
lapply(t, function(x) {
tokens <- segment(x, jieba_tokenizer)
tokens <- tokens[nchar(tokens)>1]
return(tokens)
})
}t_tokens <- trump_csv %>%
unnest_tokens(word, artContent, token=t_tokenizer) %>%
select(-artTime, -artUrl)
t_tokens_count <- t_tokens %>%
group_by(word) %>%
summarise(sum = n()) %>%
arrange(desc(sum))
head(t_tokens_count)## # A tibble: 6 x 2
## word sum
## <chr> <int>
## 1 美國 2829
## 2 川普 2402
## 3 中國 1719
## 4 疫情 1086
## 5 病毒 1073
## 6 總統 9421.3 文字雲
wordc_plot <- t_tokens_count %>%
filter(word != "川普" & word != "美國" & word != "中國") %>%
filter(sum > 100) %>%
wordcloud2()
wordc_plot列出02/27, 03/06, 03/13, 03/20, 03/24, 04/15出現頻率最高的詞彙
t_tokens_by_date <- t_tokens %>%
count(artDate, word, sort = TRUE)
plot_merge <- t_tokens_by_date %>%
filter(word != "川普" & word != "中國" & word != "美國") %>%
filter(artDate == as.Date("2020-02-27") |
artDate == as.Date("2020-03-06") |
artDate == as.Date("2020-03-13") |
artDate == as.Date("2020-03-20") |
artDate == as.Date("2020-03-27") |
artDate == as.Date("2020-04-15")) %>%
group_by(artDate) %>%
top_n(7, n) %>%
ungroup() %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(x=word, y=n, fill = artDate)) +
geom_col(show.legend = FALSE) +
labs(x = NULL, y = NULL) +
facet_wrap(~artDate, scales="free", ncol = 2) +
coord_flip()
plot_merge
1.4 情緒分析
data = fread('trump3_artWordFreq.csv',encoding = 'UTF-8')
head(data)## artTitle artDate artTime
## 1: [新聞]川普稱：疫情4月會消失 2020/02/10 14:03:51
## 2: [新聞]川普稱：疫情4月會消失 2020/02/10 14:03:51
## 3: [新聞]川普稱：疫情4月會消失 2020/02/10 14:03:51
## 4: [新聞]川普稱：疫情4月會消失 2020/02/10 14:03:51
## 5: [新聞]川普稱：疫情4月會消失 2020/02/10 14:03:51
## 6: [新聞]川普稱：疫情4月會消失 2020/02/10 14:03:51
## artUrl word count
## 1: https://www.ptt.cc/bbs/Gossiping/M.1581372600.A.FAF.html 病毒 4
## 2: https://www.ptt.cc/bbs/Gossiping/M.1581372600.A.FAF.html 疫情 4
## 3: https://www.ptt.cc/bbs/Gossiping/M.1581372600.A.FAF.html 完整 3
## 4: https://www.ptt.cc/bbs/Gossiping/M.1581372600.A.FAF.html 消失 3
## 5: https://www.ptt.cc/bbs/Gossiping/M.1581372600.A.FAF.html 中央社 2
## 6: https://www.ptt.cc/bbs/Gossiping/M.1581372600.A.FAF.html 華盛頓 2過濾特殊字元
data = data %>%
filter(!grepl('_',word))轉換日期格式
data$artDate= data$artDate %>% as.Date("%Y/%m/%d")計算所有字在文集中的總詞頻
word_count <- data %>%
select(word,count) %>%
group_by(word) %>%
summarise(count = sum(count)) %>%
filter(count>3) %>% # 過濾出現太少次的字
arrange(desc(count))
word_count## # A tibble: 4,425 x 2
## word count
## <chr> <int>
## 1 美國 2823
## 2 川普 2358
## 3 中國 1722
## 4 疫情 1086
## 5 病毒 943
## 6 總統 886
## 7 記者 820
## 8 完整 793
## 9 肺炎 744
## 10 新聞 739
## # ... with 4,415 more rows以LIWC字典判斷文集中的word屬於正面字還是負面字
# 正向字典txt檔
# 以,將字分隔
P <- read_file("dict/liwc/positive.txt")
# 負向字典txt檔
N <- read_file("dict/liwc/negative.txt")#將字串依,分割
#strsplit回傳list , 我們取出list中的第一個元素
P = strsplit(P, ",")[[1]]
N = strsplit(N, ",")[[1]]
# 建立dataframe 有兩個欄位word,sentiments，word欄位內容是字典向量
P = data.frame(word = P, sentiment = "positive")
N = data.frame(word = N, sentiment = "negative")LIWC = rbind(P, N)
head(LIWC)## word sentiment
## 1 一流 positive
## 2 下定決心 positive
## 3 不拘小節 positive
## 4 不費力 positive
## 5 不錯 positive
## 6 主動 positiveword_count %>% inner_join(LIWC)## Joining, by = "word"## Warning: Column `word` joining character vector and factor, coercing into
## character vector## # A tibble: 332 x 3
## word count sentiment
## <chr> <int> <fct>
## 1 問題 241 negative
## 2 死亡 220 negative
## 3 支持 205 positive
## 4 希望 181 positive
## 5 爆發 158 negative
## 6 嚴重 154 negative
## 7 批評 131 negative
## 8 決定 118 positive
## 9 警告 106 negative
## 10 流行 97 positive
## # ... with 322 more rowsdata %>%
select(word) %>%
inner_join(LIWC)## Joining, by = "word"以LIWC情緒字典分析
統計每天的文章正面字的次數與負面字的次數
sentiment_count = data %>%
select(artDate,word,count) %>%
inner_join(LIWC) %>%
group_by(artDate,sentiment) %>%
summarise(count=sum(count))## Joining, by = "word"sentiment_count %>%
ggplot()+
geom_line(aes(x=artDate,y=count,colour=sentiment))+
geom_vline(xintercept = c(as.numeric(as.Date("2020-03-20")),
as.numeric(as.Date("2020-03-17")),
as.numeric(as.Date("2020-03-13")),
as.numeric(as.Date("2020-04-15")),
as.numeric(as.Date("2020-02-27")),
as.numeric(as.Date("2020-03-06")),
as.numeric(as.Date("2020-03-24"))), col='red', size = 1)
scale_x_date(labels = date_format("%m/%d")) ## <ScaleContinuousDate>
## Range:
## Limits: 0 -- 1sentiment_count %>%
ggplot()+
geom_line(aes(x=artDate,y=count,colour=sentiment))+
scale_x_date(labels = date_format("%m/%d"))+
geom_vline(xintercept = c(as.numeric(as.Date("2020-03-20")),
as.numeric(as.Date("2020-03-17")),
as.numeric(as.Date("2020-03-13")),
as.numeric(as.Date("2020-04-15")),
as.numeric(as.Date("2020-02-27")),
as.numeric(as.Date("2020-03-06")),
as.numeric(as.Date("2020-03-24"))), col='red', size = 1) 
透過觀察情緒變化來回顧事件內容
data %>% filter(artDate == as.Date('2020/03/20')) %>% distinct(artUrl, .keep_all = TRUE)## artTitle artDate artTime
## 1 [新聞]簡報「冠狀」病毒川普劃掉寫上「中國」 2020-03-20 00:16:54
## 2 [新聞]川普再稱中國病毒林書豪怒嗆種族歧視 2020-03-20 00:25:23
## 3 [新聞]疫情爆炸！川普堅喊「中國病毒」亞裔女 2020-03-20 00:29:55
## 4 Re:[新聞]疫情爆炸！川普堅喊「中國病毒」亞裔女 2020-03-20 00:40:53
## 5 Re:[新聞]疫情爆炸！川普堅喊「中國病毒」亞裔女 2020-03-20 00:57:02
## 6 Re:[新聞]簡報「冠狀」病毒川普劃掉寫上「中國」 2020-03-20 01:02:06
## 7 Re:[新聞]疫情爆炸！川普堅喊「中國病毒」亞裔女 2020-03-20 01:05:26
## 8 [新聞]川普痛批隱瞞疫情後劃掉「新冠」直接改成 2020-03-20 01:32:26
## 9 [新聞]中國首傳境內零新增肺炎病例川普：真假 2020-03-20 01:39:13
## 10 Re:[新聞]川普痛批隱瞞疫情後劃掉「新冠」直接改成 2020-03-20 01:41:05
## 11 [問卦]是不是只有台灣人特別愛川普啊 2020-03-20 01:42:05
## 12 [問卦]我大川普是不是武漢肺炎的最大贏家? 2020-03-20 01:50:00
## 13 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 01:53:53
## 14 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 02:10:45
## 15 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 02:17:04
## 16 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 02:26:26
## 17 Re:[新聞]疫情爆炸！川普堅喊「中國病毒」亞裔女 2020-03-20 02:30:16
## 18 [新聞]川普堅持「正名」中國！演講稿寫冠狀病 2020-03-20 02:31:20
## 19 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 02:40:54
## 20 Re:[新聞]川普堅持「正名」中國！演講稿寫冠狀病 2020-03-20 02:46:54
## 21 Re:[新聞]川普堅持「正名」中國！演講稿寫冠狀病 2020-03-20 02:55:20
## 22 Re:[新聞]川普堅持「正名」中國！演講稿寫冠狀病 2020-03-20 03:10:43
## 23 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 03:23:04
## 24 [問卦]川普是不是在賣亡國感？ 2020-03-20 03:24:52
## 25 Re:[新聞]為何堅稱「中國病毒」？川普：因為是從 2020-03-20 03:33:24
## 26 Re:[新聞]川普堅持「正名」中國！演講稿寫冠狀病 2020-03-20 03:37:35
## 27 Re:[新聞]川普堅持「正名」中國！演講稿寫冠狀病 2020-03-20 03:48:08
## 28 [新聞]紐約油價激漲24％「史上最猛」！川普買3 2020-03-20 04:03:54
## 29 Re:[新聞]為何堅稱「中國病毒」？川普：因為是從 2020-03-20 04:08:59
## 30 Re:[新聞]為何堅稱「中國病毒」？川普：因為是從 2020-03-20 04:14:13
## 31 Re:[新聞]為何堅稱「中國病毒」？川普：因為是從 2020-03-20 04:18:12
## 32 [問卦]目前美國論壇民調支持川普還是舔共拜登？ 2020-03-20 04:31:54
## 33 [新聞]中國宣布境內0確診川普:誰知道呢 2020-03-20 04:50:51
## 34 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 05:33:09
## 35 [問卦]川普BYE了吧？？？？ 2020-03-20 06:11:26
## 36 Re:[新聞]簡報「冠狀」病毒川普劃掉寫上「中國」 2020-03-20 06:26:26
## 37 Re:[問卦]是不是只有台灣人特別愛川普啊 2020-03-20 07:34:01
## 38 [問卦]川普是看風向罵中國嗎?? 2020-03-20 08:08:51
## 39 Re:[新聞]簡報「冠狀」病毒川普劃掉寫上「中國」 2020-03-20 09:48:46
## 40 [新聞]林書豪轟川普改講稿「硬說中國病毒」有感 2020-03-20 10:39:20
## 41 [爆卦]林書豪嗆川普心中要有愛再獲中國人支持 2020-03-20 10:44:56
## 42 [新聞]林書豪轟川普改講稿「硬說中國病毒」 2020-03-20 10:58:04
## 43 [新聞]川普將「冠狀」病毒劃掉寫上「中國」 2020-03-20 11:15:05
## 44 [新聞]美國富人和名人優先檢測？ 川普：這就是 2020-03-20 11:26:50
## 45 [新聞]特朗普：“我是戰時總統”，發動國防物 2020-03-20 11:49:43
## 46 Re:[新聞]簡報「冠狀」病毒川普劃掉寫上「中國」 2020-03-20 12:30:33
## 47 [問卦]川普下一招是訪台嗎？ 2020-03-20 15:44:49
## 48 [新聞]川普政府擬3週內發全民現金成人3萬兒童1萬 2020-03-20 16:06:45
## 49 [問卦]川普眼睛 2020-03-20 16:34:16
## 50 [爆卦]川普-抗疫民調滿意度55% 2020-03-20 19:07:08
## 51 Re:[爆卦]川普-抗疫民調滿意度55% 2020-03-20 19:32:21
## 52 [新聞]東京奧運是否如期舉辦？川普爆料安倍不知 2020-03-20 19:52:40
## 53 Re:[爆卦]川普-抗疫民調滿意度55% 2020-03-20 23:00:47
## artUrl word count
## 1 https://www.ptt.cc/bbs/Gossiping/M.1584663416.A.61E.html 冠狀病毒 5
## 2 https://www.ptt.cc/bbs/Gossiping/M.1584663925.A.607.html 肺炎 4
## 3 https://www.ptt.cc/bbs/Gossiping/M.1584664197.A.AAD.html 中國 7
## 4 https://www.ptt.cc/bbs/Gossiping/M.1584664855.A.750.html 台灣 19
## 5 https://www.ptt.cc/bbs/Gossiping/M.1584665824.A.0C4.html 台灣 3
## 6 https://www.ptt.cc/bbs/Gossiping/M.1584666130.A.4D3.html 中華 1
## 7 https://www.ptt.cc/bbs/Gossiping/M.1584666329.A.EC9.html 亞裔 3
## 8 https://www.ptt.cc/bbs/Gossiping/M.1584667948.A.236.html 病毒 5
## 9 https://www.ptt.cc/bbs/Gossiping/M.1584668358.A.7A5.html 中國 10
## 10 https://www.ptt.cc/bbs/Gossiping/M.1584668467.A.57D.html 中國 6
## 11 https://www.ptt.cc/bbs/Gossiping/M.1584668527.A.3B3.html 川普 5
## 12 https://www.ptt.cc/bbs/Gossiping/M.1584669002.A.155.html 連任 5
## 13 https://www.ptt.cc/bbs/Gossiping/M.1584669235.A.058.html 中國 2
## 14 https://www.ptt.cc/bbs/Gossiping/M.1584670247.A.F61.html 相信 3
## 15 https://www.ptt.cc/bbs/Gossiping/M.1584670626.A.F90.html 看到 4
## 16 https://www.ptt.cc/bbs/Gossiping/M.1584671188.A.1BE.html 覺青 4
## 17 https://www.ptt.cc/bbs/Gossiping/M.1584671420.A.F77.html 新聞 5
## 18 https://www.ptt.cc/bbs/Gossiping/M.1584671482.A.744.html 中國 16
## 19 https://www.ptt.cc/bbs/Gossiping/M.1584672056.A.D6C.html 黑人 6
## 20 https://www.ptt.cc/bbs/Gossiping/M.1584672418.A.FFC.html 美國 4
## 21 https://www.ptt.cc/bbs/Gossiping/M.1584672922.A.488.html 中國 4
## 22 https://www.ptt.cc/bbs/Gossiping/M.1584673845.A.B62.html 中國 6
## 23 https://www.ptt.cc/bbs/Gossiping/M.1584674591.A.B3A.html 希拉 4
## 24 https://www.ptt.cc/bbs/Gossiping/M.1584674694.A.B9C.html 中國 2
## 25 https://www.ptt.cc/bbs/Gossiping/M.1584675207.A.78A.html 病毒 6
## 26 https://www.ptt.cc/bbs/Gossiping/M.1584675459.A.3E4.html 流感 7
## 27 https://www.ptt.cc/bbs/Gossiping/M.1584676096.A.18F.html 中國 13
## 28 https://www.ptt.cc/bbs/Gossiping/M.1584677036.A.1E7.html 油價 14
## 29 https://www.ptt.cc/bbs/Gossiping/M.1584677341.A.4DE.html 武漢 4
## 30 https://www.ptt.cc/bbs/Gossiping/M.1584677655.A.228.html 中國 3
## 31 https://www.ptt.cc/bbs/Gossiping/M.1584677894.A.88B.html 美國 5
## 32 https://www.ptt.cc/bbs/Gossiping/M.1584678716.A.50B.html 美國 4
## 33 https://www.ptt.cc/bbs/Gossiping/M.1584679855.A.E65.html 中國 14
## 34 https://www.ptt.cc/bbs/Gossiping/M.1584682391.A.115.html 美國 10
## 35 https://www.ptt.cc/bbs/Gossiping/M.1584684691.A.B96.html 川普 4
## 36 https://www.ptt.cc/bbs/Gossiping/M.1584685588.A.18C.html 大陸 4
## 37 https://www.ptt.cc/bbs/Gossiping/M.1584689646.A.754.html 漫畫 2
## 38 https://www.ptt.cc/bbs/Gossiping/M.1584691733.A.5BF.html 中國 2
## 39 https://www.ptt.cc/bbs/Gossiping/M.1584697728.A.0D0.html 歧視 6
## 40 https://www.ptt.cc/bbs/Gossiping/M.1584700763.A.992.html 中國 10
## 41 https://www.ptt.cc/bbs/Gossiping/M.1584701098.A.A37.html 用戶 5
## 42 https://www.ptt.cc/bbs/Gossiping/M.1584701886.A.D9A.html 中國 10
## 43 https://www.ptt.cc/bbs/Gossiping/M.1584702907.A.241.html 中國 8
## 44 https://www.ptt.cc/bbs/Gossiping/M.1584703613.A.333.html 檢測 10
## 45 https://www.ptt.cc/bbs/Gossiping/M.1584704986.A.F72.html 生產 5
## 46 https://www.ptt.cc/bbs/Gossiping/M.1584707436.A.69A.html 民主黨 7
## 47 https://www.ptt.cc/bbs/Gossiping/M.1584719091.A.BFD.html 一招 2
## 48 https://www.ptt.cc/bbs/Gossiping/M.1584720409.A.AA8.html 美元 10
## 49 https://www.ptt.cc/bbs/Gossiping/M.1584722058.A.B57.html 川普 1
## 50 https://www.ptt.cc/bbs/Gossiping/M.1584731230.A.823.html 滿意 4
## 51 https://www.ptt.cc/bbs/Gossiping/M.1584732743.A.6E1.html 川普 25
## 52 https://www.ptt.cc/bbs/Gossiping/M.1584733964.A.ABB.html 安倍 6
## 53 https://www.ptt.cc/bbs/Gossiping/M.1584745248.A.917.html 川普 2data %>%
filter(artDate == as.Date('2020/03/20')) %>%
select(word,count) %>%
group_by(word) %>%
summarise(count = sum(count)) %>%
filter(count>15) %>% # 過濾出現太少次的字
wordcloud2()
哪篇文章的負面情緒最多？負面情緒的字是？
data %>%
filter(artDate == as.Date('2020/03/20')) %>%
inner_join(LIWC) %>%
filter(sentiment == "negative") %>%
group_by(artUrl,sentiment) %>%
summarise(
artTitle = artTitle[1],
count = n()
) %>%
arrange(desc(count))## Joining, by = "word"## # A tibble: 45 x 4
## # Groups: artUrl [45]
## artUrl sentiment artTitle count
## <chr> <fct> <chr> <int>
## 1 https://www.ptt.cc/bbs/Gossiping~ negative Re:[新聞]疫情爆炸！川普堅喊「中國病毒」亞裔女~ 35
## 2 https://www.ptt.cc/bbs/Gossiping~ negative Re:[爆卦]川普-抗疫民調滿意度55%~ 23
## 3 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]紐約油價激漲24％「史上最猛」！川普買3~ 9
## 4 https://www.ptt.cc/bbs/Gossiping~ negative Re:[新聞]簡報「冠狀」病毒川普劃掉寫上「中國」~ 9
## 5 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]美國富人和名人優先檢測？ 川普：這就是~ 9
## 6 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]疫情爆炸！川普堅喊「中國病毒」亞裔女~ 7
## 7 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]川普痛批隱瞞疫情後劃掉「新冠」直接改成~ 7
## 8 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]川普堅持「正名」中國！演講稿寫冠狀病~ 7
## 9 https://www.ptt.cc/bbs/Gossiping~ negative Re:[問卦]是不是只有台灣人特別愛川普啊~ 7
## 10 https://www.ptt.cc/bbs/Gossiping~ negative Re:[問卦]是不是只有台灣人特別愛川普啊~ 6
## # ... with 35 more rowsdata %>%
filter(artDate == as.Date('2020/03/20')) %>%
inner_join(LIWC) %>%
group_by(word,sentiment) %>%
summarise(
count = n()
) %>% data.frame() %>%
top_n(30,wt = count) %>%
ungroup() %>%
mutate(word = reorder(word, count)) %>%
ggplot(aes(word, count, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free_y") +
labs(y = "Contribution to sentiment",
x = NULL) +
theme(text=element_text(size=14))+
coord_flip()## Joining, by = "word"
data %>%
filter(artDate %in% c(as.Date('2020/03/19'))) %>%
inner_join(LIWC) %>%
filter(sentiment == "negative") %>%
group_by(artUrl,sentiment) %>%
summarise(
artTitle = artTitle[1],
count = n()
) %>%
arrange(desc(count))## Joining, by = "word"## # A tibble: 20 x 4
## # Groups: artUrl [20]
## artUrl sentiment artTitle count
## <chr> <fct> <chr> <int>
## 1 https://www.ptt.cc/bbs/Gossiping~ negative Re:[問卦]如果川普選輸了是不是就挫賽了~ 12
## 2 https://www.ptt.cc/bbs/Gossiping~ negative Re:[問卦]如果川普選輸了是不是就挫賽了~ 11
## 3 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]世衛要川普勿稱「中國病毒」川普抗議：~ 6
## 4 https://www.ptt.cc/bbs/Gossiping~ negative Re:[新聞]為何不早說？川普：中國絕對可以早示警~ 6
## 5 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]川普堅用「中國病毒」WHO反酸一句話~ 5
## 6 https://www.ptt.cc/bbs/Gossiping~ negative Re:[問卦]川普看起來會落選 5
## 7 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]「中國病毒」是精確用詞 川普：還沒跟~ 4
## 8 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]快訊／川普簽了！「第二階段紓困法案」3~ 4
## 9 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]為何不早說？川普：中國絕對可以早示警~ 3
## 10 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]WHO翻舊帳警告川普「別再稱中國病毒」：~ 3
## 11 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]就是要稱中國病毒川普：無庸置疑~ 3
## 12 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]川普派海軍醫療船到紐約！可提供上千床位~ 3
## 13 https://www.ptt.cc/bbs/Gossiping~ negative [問卦]川普應該很生氣 3
## 14 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]白宮官員稱新冠「功夫流感」 川普卻撐腰~ 3
## 15 https://www.ptt.cc/bbs/Gossiping~ negative [新聞]中國首傳零新增肺炎病例川普：誰知道~ 3
## 16 https://www.ptt.cc/bbs/Gossiping~ negative Re:[新聞]川普堅用「中國病毒」WHO反酸一句話~ 2
## 17 https://www.ptt.cc/bbs/Gossiping~ negative [問卦]如果川普選輸了是不是就挫賽了~ 2
## 18 https://www.ptt.cc/bbs/Gossiping~ negative Re:[新聞]為何不早說？川普：中國絕對可以早示警~ 1
## 19 https://www.ptt.cc/bbs/Gossiping~ negative Re:[爆卦]川普重大推特宣言 1
## 20 https://www.ptt.cc/bbs/Gossiping~ negative Re:[問卦]川普看起來會落選 1data %>%
filter(artDate %in% c(as.Date('2020/03/21'))) %>%
inner_join(LIWC) %>%
filter(sentiment == "negative") %>%
group_by(artUrl,sentiment) %>%
summarise(
artTitle = artTitle[1],
count = n()
) %>%
arrange(desc(count))## Joining, by = "word"## # A tibble: 16 x 4
## # Groups: artUrl [16]
## artUrl sentiment artTitle count
## <chr> <fct> <chr> <int>
## 1 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]肺炎疫情失控川普怪中國美媒指政府沒把~ 16
## 2 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]防疫心累超火爆？記者提問 川普竟突開轟~ 7
## 3 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]奎寧是否新冠特效藥川普與佛奇記者會各說~ 7
## 4 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]世衛讚陸0例川普再罵中國病毒~ 6
## 5 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]川普稱中國病毒黃安「不生氣理由」陸網~ 6
## 6 https://www.ptt.cc/bbs/Gossipin~ negative Re:[新聞]防疫心累超火爆？記者提問 川普竟突開轟~ 5
## 7 https://www.ptt.cc/bbs/Gossipin~ negative Re:[問卦]各位覺得川普今年能否勝選連任~ 5
## 8 https://www.ptt.cc/bbs/Gossipin~ negative Re:[新聞]川普再稱中國病毒林書豪怒嗆種族歧視~ 3
## 9 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]史上首見川普宣布紐約州為武漢肺炎重災~ 3
## 10 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]川普稱瘧疾藥可治武漢肺炎專家當場駁斥~ 3
## 11 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]美情報1月即提出疫情預警川普當耳邊風~ 2
## 12 https://www.ptt.cc/bbs/Gossipin~ negative [問卦]川普不菸不酒，生活意外地守紀律?~ 2
## 13 https://www.ptt.cc/bbs/Gossipin~ negative Re:[爆卦]川普-抗疫民調滿意度55%~ 1
## 14 https://www.ptt.cc/bbs/Gossipin~ negative [問卦]各位覺得川普今年能否勝選連任~ 1
## 15 https://www.ptt.cc/bbs/Gossipin~ negative [新聞]川普：治瘧疾藥物有希望能對抗新冠病毒~ 1
## 16 https://www.ptt.cc/bbs/Gossipin~ negative [爆卦]川普要開記者會啦！ 1data %>%
filter(artDate == as.Date('2020/03/19')) %>%
inner_join(LIWC) %>%
group_by(word,sentiment) %>%
summarise(
count = n()
) %>% data.frame() %>%
top_n(15,wt = count) %>%
ungroup() %>%
mutate(word = reorder(word, count)) %>%
ggplot(aes(word, count, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free_y") +
labs(y = "Contribution to sentiment",
x = NULL) +
theme(text=element_text(size=14))+
coord_flip()## Joining, by = "word"
data %>%
filter(artDate == as.Date('2020/03/21')) %>%
inner_join(LIWC) %>%
group_by(word,sentiment) %>%
summarise(
count = n()
) %>% data.frame() %>%
top_n(15,wt = count) %>%
ungroup() %>%
mutate(word = reorder(word, count)) %>%
ggplot(aes(word, count, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free_y") +
labs(y = "Contribution to sentiment",
x = NULL) +
theme(text=element_text(size=14))+
coord_flip()## Joining, by = "word"
2. TF-IDF
2.1 以文章區隔計算document
t_tokens_by_art <- t_tokens %>%
filter(!str_detect(word, regex("[0-9]"))) %>%
count(artTitle, word, sort = TRUE)
t_total_words_by_art <- t_tokens_by_art %>%
group_by(artTitle) %>%
summarize(total = sum(n)) %>%
arrange(desc(total))
t_tokens_by_art <- left_join(t_tokens_by_art, t_total_words_by_art)## Joining, by = "artTitle"t_words_tf_idf <- t_tokens_by_art %>%
bind_tf_idf(word, artTitle, n)
t_words_tf_idf %>%
filter(total > 20) %>%
arrange(desc(tf_idf))## # A tibble: 78,059 x 7
## artTitle word n total tf idf tf_idf
## <chr> <chr> <int> <int> <dbl> <dbl> <dbl>
## 1 [爆卦]川普-抗疫民調滿意度55% 滿意 8 33 0.242 4.35 1.05
## 2 [問卦]死亡筆記本如果讓川普拿到他會幹嘛？~ 筆記本~ 4 26 0.154 6.65 1.02
## 3 [問卦]為什麼美國企業家只有川普當總統？ 企業家~ 3 21 0.143 6.65 0.950
## 4 Re:[問卦]川普的臉為什麼那麼橘？ 川普唱~ 3 23 0.130 6.65 0.868
## 5 [問卦]川普為什麼要拿武肺和流感比較？ 武肺 4 25 0.16 4.86 0.778
## 6 [政治]川普兒子新發明「責任輪盤」 轉到 3 25 0.12 5.96 0.715
## 7 Re:[問卦]特朗普將美國醫療資源短缺歸咎於奧巴馬~ 沒補 3 28 0.107 6.65 0.713
## 8 Re:[問卦]為什麼美國企業家只有川普當總統？~ 演講 5 33 0.152 4.57 0.693
## 9 [問卦]美國川普要向中國求償中國會被整多慘？~ 求償 3 32 0.0938 6.65 0.624
## 10 Re:[新聞]川普揚言收到金正恩「美好的信」北韓狠~ 金正恩~ 17 110 0.155 3.94 0.610
## # ... with 78,049 more rowst_words_tf_idf %>%
filter(total > 100) %>%
arrange(desc(tf_idf))## # A tibble: 66,853 x 7
## artTitle word n total tf idf tf_idf
## <chr> <chr> <int> <int> <dbl> <dbl> <dbl>
## 1 Re:[新聞]川普揚言收到金正恩「美好的信」北韓狠~ 金正恩~ 17 110 0.155 3.94 0.610
## 2 [新聞]川普宣稱沒看過疫情警告備忘錄但他的說~ 備忘錄~ 16 177 0.0904 4.86 0.439
## 3 Re:[新聞]川普揚言收到金正恩「美好的信」北韓狠~ 搶救 8 110 0.0727 5.55 0.404
## 4 [新聞]川普稱中國病毒黃安「不生氣理由」陸網~ 黃安 12 220 0.0545 6.65 0.363
## 5 [新聞]特朗普：“東京奧運會延期一年可能更好”~ 奧運會~ 14 212 0.0660 5.27 0.348
## 6 [新聞]囚犯爆確診！川普考慮釋放聯邦監獄受刑人 設下一條件~ 囚犯 10 193 0.0518 6.65 0.345
## 7 [新聞]被批“檢查遲緩”的特朗普，這壹次因急~ 檢查 22 338 0.0651 5.27 0.343
## 8 [新聞]川普建議注射消毒劑治新冠肺炎專家呼籲~ 注射 8 105 0.0762 4.46 0.339
## 9 [新聞]協助白登打敗川普楊安澤、美國優先事項~ 白登 11 216 0.0509 6.65 0.339
## 10 [新聞]美與塔利班停火7天川普：和平協議近了~ 塔利班~ 6 119 0.0504 6.65 0.335
## # ... with 66,843 more rows2.2 以日期區隔計算document
t_tokens_by_date <- t_tokens %>%
filter(!str_detect(word, regex("[0-9]"))) %>%
count(artDate, word, sort = TRUE)
t_total_words_by_date <- t_tokens_by_date %>%
group_by(artDate) %>%
summarize(total = sum(n)) %>%
arrange(desc(total))
t_tokens_by_date <- left_join(t_tokens_by_date, t_total_words_by_date)## Joining, by = "artDate"t_words_tf_idf_date <- t_tokens_by_date %>%
bind_tf_idf(word, artDate, n)
t_words_tf_idf_date %>%
filter(total > 20) %>%
group_by(artDate) %>%
top_n(1) %>%
arrange(artDate)## Selecting by tf_idf## # A tibble: 96 x 7
## # Groups: artDate [74]
## artDate word n total tf idf tf_idf
## <date> <chr> <int> <int> <dbl> <dbl> <dbl>
## 1 2020-02-10 氣溫 3 116 0.0259 3.64 0.0941
## 2 2020-02-12 轉暖 3 187 0.0160 4.33 0.0695
## 3 2020-02-13 協定 13 1130 0.0115 3.64 0.0418
## 4 2020-02-14 重<U+5553> 8 1079 0.00741 4.33 0.0321
## 5 2020-02-15 威廉 4 171 0.0234 4.33 0.101
## 6 2020-02-16 愛荷華州 5 697 0.00717 4.33 0.0311
## 7 2020-02-17 辛普森 6 169 0.0355 4.33 0.154
## 8 2020-02-18 美國公司 4 501 0.00798 4.33 0.0346
## 9 2020-02-19 強硬 3 219 0.0137 1.93 0.0265
## 10 2020-02-20 瑞爾 7 1018 0.00688 3.64 0.0250
## # ... with 86 more rowst_words_tf_idf_date %>%
filter(total > 20) %>%
filter(artDate == as.Date("2019-01-05") |
artDate == as.Date("2019-01-16") |
artDate == as.Date("2019-03-04") |
artDate == as.Date("2019-03-10") |
artDate == as.Date("2019-04-09")) %>%
group_by(artDate) %>%
top_n(1) %>%
arrange(artDate)## Selecting by tf_idf## # A tibble: 0 x 7
## # Groups: artDate [0]
## # ... with 7 variables: artDate <date>, word <chr>, n <int>, total <int>,
## # tf <dbl>, idf <dbl>, tf_idf <dbl>3. Correlation
3.1 計算word correlation
t_words_by_art <- trump_csv %>%
unnest_tokens(word, artContent, token=t_tokenizer) %>%
filter(!str_detect(word, regex("[0-9]"))) %>%
count(artUrl, word, sort = TRUE)
t_word_pairs <- t_words_by_art %>%
pairwise_count(word, artUrl, sort = TRUE)
t_word_pairs## # A tibble: 10,457,250 x 3
## item1 item2 n
## <chr> <chr> <dbl>
## 1 美國 川普 612
## 2 川普 美國 612
## 3 美國 總統 450
## 4 總統 美國 450
## 5 總統 川普 437
## 6 川普 總統 437
## 7 疫情 美國 363
## 8 美國 疫情 363
## 9 疫情 川普 356
## 10 川普 疫情 356
## # ... with 10,457,240 more rowst_word_cors <- t_words_by_art %>%
group_by(word) %>%
filter(n() >= 20) %>%
pairwise_cor(word, artUrl, sort = TRUE)
t_word_cors %>%
filter(item1 == "川普")## # A tibble: 701 x 3
## item1 item2 correlation
## <chr> <chr> <dbl>
## 1 川普 美國 0.224
## 2 川普 總統 0.193
## 3 川普 疫情 0.186
## 4 川普 綜合 0.173
## 5 川普 記者會 0.161
## 6 川普 來源 0.160
## 7 川普 媒體 0.159
## 8 川普 武漢 0.144
## 9 川普 新冠肺炎 0.136
## 10 川普 國家 0.136
## # ... with 691 more rowsseed_words <- c("ettoday", "ltn", "時報", "聯合報", "udn", "中時", "html", "n")
threshold <- 0.6
remove_words <- t_word_cors %>%
filter((item1 %in% seed_words|item2 %in% seed_words),
correlation>threshold) %>%
.$item1 %>%
unique()
set.seed(2020)
t_word_cors_new <- t_word_cors %>%
filter(!(item1 %in% remove_words|item2 %in% remove_words))
t_word_cors_new %>%
filter(correlation > .4) %>%
graph_from_data_frame() %>%
ggraph(layout = "fr") +
geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
geom_node_point(color = "lightblue", size = 3) +
geom_node_text(aes(label = name), repel = TRUE) +
theme_void()
結論
整體而言，因為ptt八卦版對於川普的討論風向主要與川普對肺炎的發言有關，因此貼文情緒會受到肺炎的影響，呈現負面情緒較高的現象。