香港反送中抗爭事件近期已滿一周年,也成為一個國際高度關注的事件,然而香港人的抗爭尚未完結。在過去的一周年中發生了許多事件,例如多次的抗爭遊行、警民衝突、訂立禁蒙面法等等至近期的國安法,這些事件都在各國的網路社群中引發高度的討論聲量。
因此在本次專案中,我們試圖在 PTT 八卦版上分析網友對於反送中過去各個事件的討論,希望能夠找出不同主題的話題趨勢,和大家對於每一個事件的情緒與討論內容。
## [1] "LC_CTYPE=zh_TW.UTF-8;LC_NUMERIC=C;LC_TIME=zh_TW.UTF-8;LC_COLLATE=zh_TW.UTF-8;LC_MONETARY=zh_TW.UTF-8;LC_MESSAGES=en_US.UTF-8;LC_PAPER=en_US.UTF-8;LC_NAME=C;LC_ADDRESS=C;LC_TELEPHONE=C;LC_MEASUREMENT=en_US.UTF-8;LC_IDENTIFICATION=C"
packages = c("readr", "tm", "data.table", "dplyr", "stringr", "jiebaR", "tidytext", "ggplot2", "tidyr", "topicmodels", "LDAvis", "igraph","knitr", "webshot", "purrr", "ramify", "RColorBrewer", "htmlwidgets", "servr", "scales", "reshape2", "widyr", "igraph", "wordcloud", "ggraph")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)
# 載入packages
library(readr)
library(tm)
library(dplyr)
library(jiebaR)
library(tidyr)
library(tidytext)
library(igraph)
library(topicmodels)
library(stringr)
library(ggplot2)
library(knitr)
library(scales)
library(reshape2)
library(widyr)
library(igraph)
library(wordcloud)
library(ggraph)
library(RColorBrewer)
require(data.table)
require(wordcloud2)
mycolors <- colorRampPalette(brewer.pal(8, "Set3"))(20)
# 文章資料
HongKong <- fread("HongKong_articleMetaData.csv", encoding = "UTF-8")
HongKong$artDate = HongKong$artDate %>% as.Date("%Y/%m/%d") # 將日期欄位格式由chr轉為date
order <- fread("HongKong.csv", encoding = "UTF-8")
order$artDate = order$artDate %>% as.Date("%Y/%m/%d") # 將日期欄位格式由chr轉為date
#回覆資料
HongKong_review <- fread("HongKong_articleReviews.csv", encoding = "UTF-8")
HongKong_review2 <- fread("HongKong_articleReviews.csv", encoding = "UTF-8")
# 選取需要的欄位
HongKong_review <- HongKong_review %>%
select(artUrl, cmtPoster, cmtStatus, cmtContent)
length(unique(HongKong$artPoster))
## [1] 3537
length(unique(HongKong_review$cmtPoster))
## [1] 45674
allPoster <- c(HongKong$artPoster, HongKong_review$cmtPoster)
length(unique(allPoster))
## [1] 46709
# 整理所有出現過的使用者:
# 若曾發過文則標註爲:Poster;不曾發過文則標註爲:Replyer
userList <- data.frame(user = unique(allPoster)) %>%
mutate(type = ifelse(user%in%HongKong$artPoster, "poster", "replyer"))
data <- order %>%
select(artDate, artUrl) %>% # 選出文章和日期欄位
distinct()
發文數最多的前十天
article_count_by_date <- data %>%
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 2019-08-12 297
## 2 2019-10-04 271
## 3 2019-08-11 193
## 4 2019-10-22 191
## 5 2020-05-26 183
## 6 2020-05-24 182
## 7 2020-05-23 174
## 8 2019-07-21 173
## 9 2019-11-13 167
## 10 2019-11-18 164
plot_date <-
# data
article_count_by_date %>%
# aesthetics
ggplot(aes(x = artDate, y = count)) +
# geometrics
geom_line(color = "#00AFBB", size = 1) +
geom_vline(xintercept = as.numeric(as.Date("2019-08-12")), col='red') +
geom_vline(xintercept = as.numeric(as.Date("2019-10-04")), col='red') +
geom_vline(xintercept = as.numeric(as.Date("2019-10-22")), col='red') +
geom_vline(xintercept = as.numeric(as.Date("2020-05-26")), col='red') +
# coordinates
scale_x_date(labels = date_format("%Y/%m/%d")) +
ggtitle("反送中討論文章數") +
xlab("日期") +
ylab("文章數")
plot_date
由圖中可以看出:
- 2019年8月以來反送中熱度不斷上漲,在8月12日達到頂峰
- 2019年10月後聲量再次回暖,分別在10月4日及22日達到第二次與第三次高峰
- 2020年後反送中熱度出現很長一段時間的低谷,直到5月中旬才出現回暖
以2020/5/26為例
order %>%
filter(artDate == as.Date('2020/05/26')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
distinct(artTitle, .keep_all = TRUE) %>%
select(artTitle) %>%
top_n(10)
## Selecting by artTitle
## artTitle
## 1 Re:[新聞]停止港澳條例?陸委會:不是要放棄香港
## 2 Re:[新聞]蔡英文:我們一起繼續撐香港的自由
## 3 Re:[新聞]蔡拋停用港澳條例反送中黃絲批:事前支
## 4 Re:[新聞]快訊/被質疑選後切割香港 蔡英文親口
## 5 Re:[新聞]國民黨批停用「港澳條例」切割香港蔡英
## 6 Re:[新聞]港版國安法爭議林鄭強調遵守國家憲法
## 7 Re:[新聞]林飛帆掛保證:「台灣絕不會放棄香港!
## 8 Re:[新聞]香港浸大學生會長:民進黨用港人鮮血換選
## 9 Re:[新聞]遭指切割香港蔡總統:國民黨講法錯誤
## 10 Re:[新聞]國民黨已提法案撐香港民進黨別只喊口號
可以發現2020/5/26當天因為國安法頒布,民進黨欲停用港澳條例,引發大量的討論聲量
以同樣的方式,分別找出其他高峰日期發生的事件:
- 2019/08/12:示威者佔領香港國際機場
- 2019/10/04:林鄭月娥頒布蒙面法
- 2019/10/22:陳同佳出獄(這一事件被認為是反送中的導火索之一,潘曉穎命案:https://zh.wikipedia.org/wiki/%E6%BD%98%E6%9B%89%E7%A9%8E%E5%91%BD%E6%A1%88)
stop_words <- fread("stop_words.txt", encoding = "UTF-8") #設定停用字
order <- order %>%
filter(!word %in% stop_words$word)
#將文章按照文字分群並計算每一個字的總詞頻
word_count <- order %>%
group_by(word) %>%
summarise(sum = sum(count)) %>%
arrange(desc(sum))
詞頻最高的前二十名
head(word_count, 20)
## # A tibble: 20 x 2
## word sum
## <chr> <int>
## 1 台灣 12554
## 2 中國 9205
## 3 中共 5315
## 4 記者 3935
## 5 警察 3463
## 6 美國 3125
## 7 警方 3037
## 8 政府 3017
## 9 示威者 2852
## 10 反送 2761
## 11 支持 2654
## 12 報導 2504
## 13 遊行 2360
## 14 抗爭 2320
## 15 民主 2117
## 16 國家 2105
## 17 港人 2050
## 18 自由 2029
## 19 抗議 1926
## 20 大陸 1879
cloud <- order %>%
group_by(word) %>%
summarise(sum = sum(count)) %>%
arrange(desc(sum)) %>%
filter(sum > 850) %>%
wordcloud2()
cloud
可以初步看出反送中議題涉及的議題非常廣
與文字雲相比,長條圖可以查看較精確的「最常出現詞彙」。
order %>%
group_by(word) %>% #根據word分組
filter(!word %in% stop_words$word) %>%
summarize(count = n()) %>% #計算每組
top_n(n = 20, count) %>%
ungroup() %>%
mutate(word = reorder(word, count)) %>%
ggplot(aes(word, count)) +
geom_col()+
ggtitle("Word Frequency ") +
theme(text=element_text(size=14))+
coord_flip()
議題主要集中於反送中活動本身與民主自由等政治方面
以 LIWC 字典判斷文集中的 word 屬於正面字還是負面字
# 正向字典txt檔
P <- read_file("positive.txt")
# 負向字典txt檔
N <- read_file("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)
sentiment_count_word = order %>%
select(artDate,word,count) %>%
inner_join(LIWC) %>%
group_by(artDate,sentiment)
sentiment_count = order %>%
select(artDate,word,count) %>%
inner_join(LIWC) %>%
group_by(artDate,sentiment) %>%
summarise(count=sum(count))
sentiment_count %>%
arrange(desc(count))
## # A tibble: 621 x 3
## # Groups: artDate [315]
## artDate sentiment count
## <date> <fct> <int>
## 1 2019-08-12 negative 984
## 2 2019-11-17 negative 750
## 3 2019-10-04 negative 747
## 4 2019-08-11 negative 664
## 5 2019-11-13 negative 661
## 6 2020-05-22 negative 649
## 7 2019-07-22 negative 645
## 8 2019-08-12 positive 633
## 9 2019-10-22 negative 582
## 10 2019-11-18 negative 582
## # … with 611 more rows
# geom_vline畫出vertical line,xintercept告訴他要在artDate欄位的哪一個row畫線
sentiment_count %>%
ggplot()+
geom_line(aes(x=artDate,y=count,colour=sentiment))+
scale_x_date(labels = date_format("%y/%m/%d"))+
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/08/12'))
[1]])),colour = "blue") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/11/17'))
[1]])),colour = "blue") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/10/04'))
[1]])),colour = "blue") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/08/11'))
[1]])),colour = "blue") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2020/05/22'))
[1]])),colour = "blue") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/11/13'))
[1]])),colour = "blue") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/07/22'))
[1]])),colour = "blue")
分析特定日期的發文標題
2019/07/22
order %>%
filter(artDate == as.Date('2019/07/22')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[新聞]影/孕婦也打!香港白衣人元朗暴行曝光1
## 2 Re:[問卦]用藤條就把香港雨傘仔打到下跪,何必槍?
## 3 Re:[新聞]林鄭月娥譴責元朗暴力指示警方緝凶
## 4 Re:[問卦]有人跟我一樣看到反送中港仔被揍很爽的嗎?
## 5 Re:[新聞]林鄭月娥譴責元朗暴力指示警方緝凶
## 6 Re:[新聞]香港白衣人暴毆柯:想想台灣何嘗不是這樣
## 7 Re:[新聞]香港反送中黃國昌:殘暴垃圾行徑宛如台
## 8 Re:[問卦]中國人微博回應香港孕婦被打事件
## 9 影/孕婦也打!香港白衣人元朗暴行曝光1人命危
## 10 Re:[新聞]影/孕婦也打!香港白衣人元朗暴行曝光1人命危
## 11 Re:[新聞]港白衣人攻擊《反送中》館長:中天你敢
## 12 Re:[問卦]香港無政府狀態了?
## 13 Re:[問卦]新、舊香港的差異處及成因在哪呢?
## 14 Re:[問卦]新、舊香港的差異處及成因在哪呢?
## 15 Re:[問卦]香港未來有救嗎?
## 16 Re:[問卦]新、舊香港的差異處及成因在哪呢?
## 17 Re:[問卦]香港未來有救嗎?
## 18 Re:[問卦]現在去香港到底安不安全啊?
## 19 Re:[問卦]現在去香港到底安不安全啊?
## 20 Re:[新聞]反送中》香港出現暴力韓國瑜譴責
## 21 Re:[問卦]政府現在走私軍火去香港有沒有搞頭?
2019/10/04
order %>%
filter(artDate == as.Date('2019/10/04')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[新聞]遊行戴口罩就關一年!林鄭月娥宣布《禁止蒙面規例》5日
## 2 Re:[新聞]香港遊行反蒙面是戒嚴?民進黨打臉徐國勇
## 3 Re:[新聞]遊行戴口罩就關一年!林鄭月娥宣布《禁止蒙面規例》5日
## 4 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 5 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 6 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 7 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 8 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 9 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 10 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 11 Re:[新聞]香港發布禁蒙面法民眾黨:人民有權蒙面
## 12 Re:[新聞]香港發布禁蒙面法民眾黨:人民有權蒙面
## 13 Re:[新聞]香港發布禁蒙面法民眾黨:人民有權蒙面
## 14 Re:[新聞]香港發布禁蒙面法民眾黨:人民有權蒙面
## 15 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 16 Re:[新聞]香港發布禁蒙面法民眾黨:人民有權蒙面
## 17 Re:[新聞]香港發布禁蒙面法民眾黨:人民有權蒙面
## 18 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 19 Re:[新聞]上千港人震撼宣讀《香港臨時政府宣言》
## 20 Re:[新聞]香港禁蒙面柯文哲:政府不要把自己眼睛
2019/11/13
order %>%
filter(artDate == as.Date('2019/11/13')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[新聞]香港情勢緊張政府協調華航今晚載回中大8
## 2 Re:[新聞]香港情勢緊張政府協調華航今晚載回中大8
## 3 Re:[新聞]香港情勢緊張政府協調華航今晚載回中大8
## 4 Re:[問卦]香港中文大學升起青天白日滿地紅
## 5 Re:[新聞]香港校園變戰場台灣學生發起「一方有難
## 6 Re:[新聞]香港校園變戰場台灣學生發起「一方有難
## 7 Re:[問卦]香港中文大學升起青天白日滿地紅
## 8 Re:[新聞]警民衝突升溫金融時報:港府失去統治正
## 9 Re:[問卦]香港為什麼會成為國際孤兒?
## 10 Re:[問卦]中國人沒被香港影響嗎
## 11 Re:[問卦]香港中文大學相當於台灣清交?
## 12 Re:[新聞]香港情勢緊張政府協調華航今晚載回中大8
## 13 Re:[新聞]香港校園衝突後:政治分歧暴力陰影下的
## 14 Re:[問卦]香港中文大學升起青天白日滿地紅
## 15 Re:[問卦]香港中文大學相當於台灣清交?
## 16 Re:[問卦]香港中文大學相當於台灣清交?
## 17 Re:[新聞]學者:中共將香港推向內戰
## 18 Re:[新聞]前美駐聯合國大使籲關注香港:香港如倒
## 19 Re:[新聞]學者:中共將香港推向內戰
## 20 Re:[新聞]學者:中共將香港推向內戰
2019/11/17
order %>%
filter(artDate == as.Date('2019/11/17')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
distinct(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[問卦]香港為啥還不革命
## 2 Re:[新聞]美參院擬快速通過香港法案華郵:川普可
## 3 Re:[爆卦]香港女生在街頭被返送中暴徒行刑式暴打!
## 4 Re:[問卦]有沒有香港搞不好很挺警察的八卦呀
## 5 Re:[問卦]看到香港直播很傷心正常嗎??
## 6 Re:[問卦]如果台灣派兵香港的掛?
## 7 Re:[問卦]有沒有香港中文大學的八卦
## 8 Re:[問卦]為何香港的抗爭無法擴大到中國各省
## 9 Re:[問卦]香港怎樣才會被外送民主啊?
## 10 Re:[問卦]怎麼沒有台灣人要去救香港理大學生?
## 11 Re:[問卦]有沒有香港理大校長失蹤的八卦?
## 12 Re:[問卦]香港難民住你家願意嗎?
## 13 Re:[新聞]清晨香港理大警民激戰理大樓梯平台成火
## 14 Re:[問卦]香港人為何不找傭兵
## 15 Re:[問卦]什麼時候會有香港大屠殺?
## 16 Re:[問卦]礦業法100篇、香港10000篇的八卦?
## 17 Re:[問卦]香港藝人死去哪了
## 18 Re:[新聞]香港高院裁定「禁蒙面法」違憲
## 19 Re:[新聞]誰比她愛台灣?香港抗爭情勢升溫…蔡英
## 20 Re:[問卦]香港理工科會做炸彈嗎?
2020/05/22
order %>%
filter(artDate == as.Date('2020/05/22')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
distinct(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[問卦]中國能阻擋香港再次百萬人反送中嗎?
## 2 Re:[問卦]台灣是不是要調高香港移民門檻??
## 3 Re:[新聞]快變一國一制!香港人徹夜狂Google「移
## 4 Re:[問卦]在高雄建立新香港
## 5 Re:[新聞]北京推「港版國安法」時力籲蔡英文公開
## 6 Re:[新聞]快訊/總統府:「港版國安法」對香港民主
## 7 Re:[新聞]若推港版國安法川普:美國將強力解決
## 8 Re:[問卦]撐香港活動一年了有改變什麼嗎?
## 9 Re:[新聞]北京推「港版國安法」國民黨:支持香港民主與雙普選、民
## 10 Re:[問卦]調查~你支持香港人移民入籍台灣嗎?
## 11 Re:[問卦]香港是不是很可憐
## 12 Re:[問卦]台灣接受香港移民有什麼好處?
## 13 Re:[問卦]香港人是不是自找的?
## 14 Re:[新聞]香港成蔡總統心中最隱形一塊...時力要蔡
## 15 Re:[問卦]在台灣建立香港村。可行嗎?
## 16 Re:[問卦]香港人來台北市房價4849會飆漲?
## 17 Re:[新聞]國台辦:奉勸民進黨停止對香港事務的政治
## 18 Re:[新聞]民進黨嚴厲譴責港版國安法宣告一國兩制
## 19 Re:[問卦]送柯韓粉去香港算介入嗎?
## 20 Re:[問卦]我認識的香港人
# geom_vline畫出vertical line,xintercept告訴他要在artDate欄位的哪一個row畫線
sentiment_count %>%
ggplot()+
geom_line(aes(x=artDate,y=count,colour=sentiment))+
scale_x_date(labels = date_format("%y/%m/%d")) +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/08/12'))
[1]])),colour = "red") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2019/12/09'))
[1]])),colour = "red") +
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2020/05/24'))
[1]])),colour = "red")
2019/12/09
order %>%
filter(artDate == as.Date('2019/12/09')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
distinct(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[問卦]鄉民願不願意大量開放香港人來台?
## 2 [新聞]蔡英文:我們一起繼續撐香港的自由
## 3 Re:[新聞]香港浸大學生會長:民進黨用港人鮮血換選
## 4 Re:[爆卦]香港浸大學生會長被出征囉!
## 5 Re:[新聞]美國推香港人權法案夠狠!原來...打的是
## 6 [新聞]香港國際人權日遊行學術宗教界紛上街力
## 7 [新聞]浸大學生會長批民進黨「不幫香港
## 8 [新聞]紐時:逾200名反送中示威者來台尋庇護
## 9 Re:[新聞]浸大學生會長批民進黨「不幫香港
## 10 [新聞]中國需要香港,但不需要香港人!
## 11 Re:[問卦]香港年輕人想要免費移民台灣就是了?!
## 12 [新聞]香港華仁書院驚現10Kg土製炸彈爆炸威力1
## 13 Re:[問卦]半年前台灣撐香港喊得鎮天嘎響的在幹嘛?
## 14 Re:[問卦]讓香港人移民台灣有什麼好處?
## 15 Re:[問卦]要怎麼撐香港?
## 16 [新聞]被批用香港人鮮血換選票蔡英文:我不覺得
## 17 [新聞]總統:沒利用香港人選舉是台灣人自我警
## 18 [新聞]紐時.200多香港示威者逃抵台灣有人搭船
## 19 Re:[新聞]總統:沒利用香港人選舉是台灣人自我警
## 20 [新聞]挑戰NBA、暴雪娛樂》美國12歲少年撐香港
2020/05/24
order %>%
filter(artDate == as.Date('2020/05/24')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
distinct(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[問卦]香港人:台灣說撐香港卻把移民門檻調高
## 2 Re:[問卦]香港人來台灣不好嗎
## 3 Re:[問卦]為什麼要把我國與香港綁在一起呢?
## 4 Re:[新聞]關心且介入香港議題民眾黨團提案修港澳條例
## 5 Re:[問卦]中國能阻擋香港再次百萬人反送中嗎?
## 6 Re:[新聞]香港「反國安法大遊行」爆衝突 港警發射
## 7 Re:[問卦]香港水深火熱怎不見陳為廷出來發言或作
## 8 Re:[問卦]香港真的沒救了
## 9 Re:[新聞]今日香港明日台灣?孫大千:腦袋壞了或
## 10 Re:[問卦]有沒有人看到香港越慘,覺得越爽的?
## 11 Re:[新聞]港版國安法闖關 民眾黨提修法給「政治
## 12 Re:[新聞]更新中:反國安法遊行警射催淚彈120餘
## 13 Re:[新聞]救人!英媒:倫敦當局準備接受香港難民
## 14 Re:[新聞]快訊/蔡英文:這一刻,我們都和香港人
## 15 Re:[問卦]有沒有香港澳門關係條例60條的八卦
## 16 Re:[新聞]港國安法引關注王毅:香港是中國內政
## 17 Re:[問卦]香港人乾脆移民到英屬福克蘭群島可以吧?
## 18 Re:[問卦]香港人知道逃來台灣還是要當中國人嗎?
## 19 Re:[新聞]時代力量肯定蔡英文聲援香港呼籲蘇貞昌
## 20 Re:[問卦]香港當初回歸中國是什麼情況啊?
2019/08/12
order %>%
filter(artDate == as.Date('2019/08/12')) %>%
distinct(artUrl, .keep_all = TRUE) %>%
select(artTitle) %>%
distinct(artTitle) %>%
top_n(20)
## Selecting by artTitle
## artTitle
## 1 Re:[問卦]香港最好的結局是啥
## 2 Re:[新聞]中國港澳辦定義香港示威為恐怖主義苗頭
## 3 Re:[新聞]蔡英文:我們一起繼續撐香港的自由
## 4 Re:[問卦]有沒有香港現在做的一切都晚了23年?
## 5 Re:[問卦]只有我覺得北京政府很容忍香港了嗎?
## 6 Re:[問卦]中共飛彈會朝香港發射嗎
## 7 Re:[新聞]黃捷募集香港物資詹江村要告違反國安法
## 8 Re:[問卦]中共會蠢到派解放軍去香港嗎?
## 9 Re:[新聞]香港機管局:13日早上6時重新分配航班
## 10 Re:[問卦]這一套出兵香港的計劃大家覺得可不可行
## 11 Re:[新聞]反送中示威傳北京要求用警隊和重刑鎮壓
## 12 Re:[問卦]香港現在的民眾領袖是誰?
## 13 Re:[新聞]反送中事件鄭文燦:香港民主分水嶺
## 14 Re:[新聞]郭文貴再爆:香港4至6日間戒嚴中國絕對
## 15 Re:[問卦]香港事件是不是很難演變成遍地開花?
## 16 Re:[問卦]香港越亂對台灣越有利?
## 17 Re:[問卦]這波香港民眾真的能戰勝邪惡共產黨嗎
## 18 香港人為什麼不理性抗議就好?
## 19 台灣有辦法把香港眼睛受傷的女孩治好嗎?
## 20 Re:[新聞]人民日報:民進黨和台獨介入香港暴亂證據
sentiment_count_word %>%
filter(artDate == as.Date('2019/08/12')) %>%
count(word, sentiment, sort = TRUE) %>%
acast(word ~ sentiment, value.var = "n", fill = 0) %>%
comparison.cloud(colors = c("gray20", "gray80"),
max.words = 100)
# Join文章與回覆
posts_Reviews <- merge(x = HongKong, y = HongKong_review, by = "artUrl")
# 取出 cmtPoster(回覆者)、artPoster(發文者)、artUrl(文章連結)三個欄位
link <- posts_Reviews %>%
select(cmtPoster, artPoster, artUrl)
reviewNetwork <- graph_from_data_frame(d=link, directed=T)
由於人數眾多,我們設定一些條件來篩選資料
1. 篩選發文數 > 5:代表發文者是否高度關注該主題並熱於分享
2. 篩選回文數 > 100:代表發文者的文章是否能一定引起共鳴
HongKong_poster = table(HongKong$artPoster) %>% sort %>% as.data.frame
colnames(HongKong_poster) = c("artPoster","freq")
HongKong_poster = HongKong_poster %>% filter(freq >= 5) # 發文次數 > 5
link <- posts_Reviews %>%
filter(commentNum >= 100) %>% # 回覆數 > 100
filter(artPoster==HongKong_poster$artPoster) %>%
select(cmtPoster, artPoster, artUrl) %>%
unique()
# 篩選 link 中有出現的使用者
filtered_user <- userList %>%
filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
arrange(desc(type))
set.seed(487)
# 先把關係的方向性拿掉,減少圖片中的不必要的資訊
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=F)
plot(reviewNetwork, vertex.size=3, edge.arrow.size=.2, vertex.label=NA)
set.seed(487)
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
# 依使用者的身份來區分點的顏色:有發文的話是金色,只有回覆文章的則是淺藍色
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
# 依據回覆發生的文章所對應的主題,對他們的關聯線進行上色
#E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$cmtStatus == "推", "lightgreen", "palevioletred")
# 顯示超過 13 個關聯的使用者帳號
plot(reviewNetwork, vertex.size = 3, edge.arrow.size=.2,
vertex.label=ifelse(degree(reviewNetwork) >= 13, V(reviewNetwork)$label, NA), vertex.label.font = 2)
從網路關係圖可以發現文章產生較多回覆的帳號為:chenglap、KAKAii、windsine、gaucher
進一步分析 chenglap、KAKAii、windsine、gaucher 這四位意見領袖
leader_data <- HongKong %>%
filter((artPoster == "chenglap")|(artPoster == "KAKAii")|(artPoster == "windsine")|(artPoster == "gaucher"))
leader_data$artDate = as.Date(leader_data$artDate)
leader_data = leader_data %>% mutate(months = as.Date(cut(artDate, "months")))
leader_data_month = leader_data %>% group_by(months,artPoster) %>%
summarise(num=n()) %>% as.data.frame
# 整合發文趨勢圖
leader_data_month %>% ggplot(aes(x= months,y=num,fill=artPoster)) +geom_bar(stat = "identity")+
facet_wrap(~artPoster, ncol = 2, scales = "fixed")
chenglap 以及 gaucher 兩個發文者的發文曲線與反送中整體發文熱度大致相符,可以得知兩位發文者屬於持續關注此議題的人物。
而 KAKAii 僅參與了前中期,後期就沒有再發表任何文章
windsine 則只有在7月份發表特別多文章,推測此人可能只關注於某些特定的議題
文字雲
chenglap_data <- leader_data %>%
filter(artPoster == "chenglap")
chenglap_sentence <- chenglap_data %>%
select(artUrl,sentence)
chenglap_sentence <-strsplit(chenglap_sentence$sentence,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
chenglap_sentence <- data.frame(
artUrl = rep(chenglap_data$artUrl, sapply(chenglap_sentence, length)),
sentence = unlist(chenglap_sentence)) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
chenglap_sentence$sentence <- as.character(chenglap_sentence$sentence)
# 使用斷詞引擎,放入要用的詞典和停用字
jieba_tokenizer = worker(user="HongKong_lexicon.txt", stop_word = "stop_words.txt", write = "NOFILE")
HongKong_tokenizer <- function(t) {
lapply(t, function(x) {
if(nchar(x)>1){
tokens <- segment(x, jieba_tokenizer)
tokens <- tokens[nchar(tokens)>1]
return(tokens)
}
})
}
# 進行斷詞,並計算各詞彙在各文章中出現的次數
chenglap_word <- chenglap_sentence %>%
unnest_tokens(word, sentence, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
# 畫出文字雲
#chenglap_word %>%
# group_by(word) %>%
# summarise(sum = n()) %>%
# filter(sum > 5) %>%
# arrange(desc(sum)) %>%
# wordcloud2()
詞彙相關性
# 計算兩個詞彙間的相關性
chenglap_word_cors <- chenglap_word %>%
group_by(word) %>%
filter(n() >= 10) %>%
pairwise_cor(word, artUrl, sort = TRUE)
chenglap_word_cors %>%
filter(correlation > 0.5) %>%
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()
從文字雲以及詞彙相關圖可以發現 chenglap 的文章除了和關注於港警衝突之外,也對政治方面有相當的關注
文字雲
gaucher_data <- leader_data %>%
filter(artPoster == "gaucher")
gaucher_sentence <- gaucher_data %>%
select(artUrl,sentence)
gaucher_sentence <-strsplit(gaucher_sentence$sentence,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
gaucher_sentence <- data.frame(
artUrl = rep(gaucher_data$artUrl, sapply(gaucher_sentence, length)),
sentence = unlist(gaucher_sentence)) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
gaucher_sentence$sentence <- as.character(gaucher_sentence$sentence)
# 進行斷詞,並計算各詞彙在各文章中出現的次數
gaucher_word <- gaucher_sentence %>%
unnest_tokens(word, sentence, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
# 畫出文字雲
#gaucher_word %>%
# group_by(word) %>%
# summarise(sum = n()) %>%
# filter(sum > 5) %>%
# arrange(desc(sum)) %>%
# wordcloud2()
詞彙相關性
# 計算兩個詞彙間的相關性
gaucher_word_cors <- gaucher_word %>%
group_by(word) %>%
filter(n() >= 10) %>%
pairwise_cor(word, artUrl, sort = TRUE)
gaucher_word_cors %>%
filter(correlation > 0.3) %>%
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()
從文字雲以及詞彙相關圖可以發現 gaucher 與前面的chenglap不同,他比較集中在關注警察方面的事件
文字雲
windsine_data <- leader_data %>%
filter(artPoster == "windsine")
windsine_sentence <- windsine_data %>%
select(artUrl,sentence)
windsine_sentence <-strsplit(windsine_sentence$sentence,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
windsine_sentence <- data.frame(
artUrl = rep(windsine_data$artUrl, sapply(windsine_sentence, length)),
sentence = unlist(windsine_sentence)) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
windsine_sentence$sentence <- as.character(windsine_sentence$sentence)
# 進行斷詞,並計算各詞彙在各文章中出現的次數
windsine_word <- windsine_sentence %>%
unnest_tokens(word, sentence, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
# 畫出文字雲
#windsine_word %>%
# group_by(word) %>%
# summarise(sum = n()) %>%
# filter(sum > 5) %>%
# arrange(desc(sum)) %>%
# wordcloud2()
從文字雲可以發現 windsine 也是比較集中在關注警察方面的事件
文字雲
KAKAii_data <- leader_data %>%
filter(artPoster == "KAKAii")
KAKAii_sentence <- KAKAii_data %>%
select(artUrl,sentence)
KAKAii_sentence <-strsplit(KAKAii_sentence$sentence,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
KAKAii_sentence <- data.frame(
artUrl = rep(KAKAii_data$artUrl, sapply(KAKAii_sentence, length)),
sentence = unlist(KAKAii_sentence)) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
KAKAii_sentence$sentence <- as.character(KAKAii_sentence$sentence)
# 進行斷詞,並計算各詞彙在各文章中出現的次數
KAKAii_word <- KAKAii_sentence %>%
unnest_tokens(word, sentence, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
# 畫出文字雲
#KAKAii_word %>%
# group_by(word) %>%
# summarise(sum = n()) %>%
# filter(sum > 5) %>%
# arrange(desc(sum)) %>%
# wordcloud2()
從文字雲以及詞彙相關圖可以發現 KAKAii 也是比較集中在關注警察方面的事件,而從文字雲出現的「消息」、「網址」、「現場」、「來源」,我們可以發現他可能屬於事件轉發者,而非發表看法的意見表達者
chenglap 情緒整理
chenglap_article_sent <- chenglap_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
chenglap_article_sent <-chenglap_article_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(artsentiment = positive - negative)
chenglap_review <- HongKong_review2 %>%
filter(artPoster == "chenglap")
chenglap_review_content <- chenglap_review %>%
select(artUrl,cmtContent)
chenglap_review_content <-strsplit(chenglap_review_content$cmtContent,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
chenglap_review_content <- data.frame(
artUrl = rep(chenglap_review$artUrl, sapply(chenglap_review_content, length)),
cmtContent = unlist(chenglap_review_content)) %>%
filter(!str_detect(cmtContent, regex("^(\t|\n| )*$")))
chenglap_review_content$cmtContent <- as.character(chenglap_review_content$cmtContent)
# 進行斷詞,並計算各詞彙在各文章中出現的次數
chenglap_review_word <- chenglap_review_content %>%
unnest_tokens(word, cmtContent, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
chenglap_review_sent <- chenglap_review_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
chenglap_review_sent <-chenglap_review_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(cmtsentiment = positive - negative)
chenglap_atr_cmt_sen <-
merge(x = chenglap_article_sent, y = chenglap_review_sent, by = "artUrl") %>%
select(artUrl,artsentiment,cmtsentiment)
chenglap_atr_cmt_sen <- chenglap_atr_cmt_sen %>%
gather(sentiment,n,artsentiment:cmtsentiment) %>%
mutate(sentiment = gsub("sentiment","",sentiment)) %>%
arrange(artUrl,sentiment)
chenglap_sen_plot <- chenglap_atr_cmt_sen %>%
ggplot(aes(artUrl,n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, ncol = 1, scales = "free_y") +
ggtitle("chenglap發文情緒與回覆情緒比較")
gaucher 情緒整理
gaucher_article_sent <- gaucher_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
gaucher_article_sent <-gaucher_article_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(artsentiment = positive - negative)
gaucher_review <- HongKong_review2 %>%
filter(artPoster == "gaucher")
gaucher_review_content <- gaucher_review %>%
select(artUrl,cmtContent)
gaucher_review_content <-strsplit(gaucher_review_content$cmtContent,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
gaucher_review_content <- data.frame(
artUrl = rep(gaucher_review$artUrl, sapply(gaucher_review_content, length)),
cmtContent = unlist(gaucher_review_content)) %>%
filter(!str_detect(cmtContent, regex("^(\t|\n| )*$")))
gaucher_review_content$cmtContent <- as.character(gaucher_review_content$cmtContent)
# 進行斷詞,並計算各詞彙在各文章中出現的次數
gaucher_review_word <- gaucher_review_content %>%
unnest_tokens(word, cmtContent, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
gaucher_review_sent <- gaucher_review_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
gaucher_review_sent <-gaucher_review_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(cmtsentiment = positive - negative)
gaucher_atr_cmt_sen <-
merge(x = gaucher_article_sent, y = gaucher_review_sent, by = "artUrl") %>%
select(artUrl,artsentiment,cmtsentiment)
gaucher_atr_cmt_sen <- gaucher_atr_cmt_sen %>%
gather(sentiment,n,artsentiment:cmtsentiment) %>%
mutate(sentiment = gsub("sentiment","",sentiment)) %>%
arrange(artUrl,sentiment)
gaucher_sen_plot <- gaucher_atr_cmt_sen %>%
ggplot(aes(artUrl,n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, ncol = 1, scales = "free_y") +
ggtitle("gaucher發文情緒與回覆情緒比較")
windsiner 情緒整理
windsine_article_sent <- windsine_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
windsine_article_sent <-windsine_article_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(artsentiment = positive - negative)
windsine_review <- HongKong_review2 %>%
filter(artPoster == "windsine")
windsine_review_content <- windsine_review %>%
select(artUrl,cmtContent)
windsine_review_content <-strsplit(windsine_review_content$cmtContent,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
windsine_review_content <- data.frame(
artUrl = rep(windsine_review$artUrl, sapply(windsine_review_content, length)),
cmtContent = unlist(windsine_review_content)) %>%
filter(!str_detect(cmtContent, regex("^(\t|\n| )*$")))
windsine_review_content$cmtContent <- as.character(windsine_review_content$cmtContent)
# 進行斷詞,並計算各詞彙在各文章中出現的次數
windsine_review_word <- windsine_review_content %>%
unnest_tokens(word, cmtContent, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
windsine_review_sent <- windsine_review_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
windsine_review_sent <-windsine_review_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(cmtsentiment = positive - negative)
windsine_atr_cmt_sen <-
merge(x = windsine_article_sent, y = windsine_review_sent, by = "artUrl") %>%
select(artUrl,artsentiment,cmtsentiment)
windsine_atr_cmt_sen <- windsine_atr_cmt_sen %>%
gather(sentiment,n,artsentiment:cmtsentiment) %>%
mutate(sentiment = gsub("sentiment","",sentiment)) %>%
arrange(artUrl,sentiment)
windsine_sen_plot <- windsine_atr_cmt_sen %>%
ggplot(aes(artUrl,n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, ncol = 1, scales = "free_y") +
ggtitle("windsine發文情緒與回覆情緒比較")
KAKAii 情緒整理
KAKAii_article_sent <- KAKAii_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
KAKAii_article_sent <-KAKAii_article_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(artsentiment = positive - negative)
KAKAii_review <- HongKong_review2 %>%
filter(artPoster == "KAKAii")
KAKAii_review_content <- KAKAii_review %>%
select(artUrl,cmtContent)
KAKAii_review_content <-strsplit(KAKAii_review_content$cmtContent,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
KAKAii_review_content <- data.frame(
artUrl = rep(KAKAii_review$artUrl, sapply(KAKAii_review_content, length)),
cmtContent = unlist(KAKAii_review_content)) %>%
filter(!str_detect(cmtContent, regex("^(\t|\n| )*$")))
KAKAii_review_content$cmtContent <- as.character(KAKAii_review_content$cmtContent)
# 進行斷詞,並計算各詞彙在各文章中出現的次數
KAKAii_review_word <- KAKAii_review_content %>%
unnest_tokens(word, cmtContent, token=HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
KAKAii_review_sent <- KAKAii_review_word %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=sum(n))
## Joining, by = "word"
## Warning: Column `word` joining character vector and factor, coercing into
## character vector
KAKAii_review_sent <-KAKAii_review_sent %>%
spread(sentiment, count, fill = 0) %>%
mutate(cmtsentiment = positive - negative)
KAKAii_atr_cmt_sen <-
merge(x = KAKAii_article_sent, y = KAKAii_review_sent, by = "artUrl") %>%
select(artUrl,artsentiment,cmtsentiment)
KAKAii_atr_cmt_sen <- KAKAii_atr_cmt_sen %>%
gather(sentiment,n,artsentiment:cmtsentiment) %>%
mutate(sentiment = gsub("sentiment","",sentiment)) %>%
arrange(artUrl,sentiment)
KAKAii_sen_plot <- KAKAii_atr_cmt_sen %>%
ggplot(aes(artUrl,n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, ncol = 1, scales = "free_y") +
ggtitle("KAKAii發文情緒與回覆情緒比較")
四位意見領袖發文及回文情緒圖
par(mfrow=c(2,2), mar=c(0,0,0,0)) # plot four figures - 2 rows, 2 columns
plot(chenglap_sen_plot)
plot(gaucher_sen_plot)
plot(windsine_sen_plot)
plot(KAKAii_sen_plot)
chenglap:發文情緒與回文情緒的起伏大致相同,而文章及回覆情緒有正向也有負向
gaucher:發文情緒與回文情緒的起伏大致相同,但可以發現發文及回覆的負面情緒比較多
windsine:回覆的情緒幾乎都是負面的
KAKAii:文章情緒的詞彙起伏不大,而其回覆的情緒幾乎都是負面的
# 斷句
HongKong_meta <- HongKong %>%
mutate(sentence=gsub("[\n]{2,}", "。", sentence))
# 以全形或半形驚歎號、問號、分號以及全形句號進行斷句
HongKong_sentences <- strsplit(HongKong_meta$sentence,"[。!;?!?;]")
# 將每句句子與他所屬的文章連結配對起來,整理成一個dataframe
HongKong_sentences <- data.frame(
artUrl = rep(HongKong_meta$artUrl, sapply(HongKong_sentences, length)),
sentence = unlist(HongKong_sentences)
) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
HongKong_sentences$sentence <- as.character(HongKong_sentences$sentence)
# 斷詞
# 使用斷詞引擎,放入要用的詞典和停用字
jieba_tokenizer = worker(user="HongKong_lexicon.txt", stop_word = "stop_words.txt", write = "NOFILE")
HongKong_tokenizer <- function(t) {
lapply(t, function(x) {
if(nchar(x)>1){
tokens <- segment(x, jieba_tokenizer)
# 去掉字串長度爲1的詞彙
tokens <- tokens[nchar(tokens)>1]
return(tokens)
}
})
}
HongKong_tokens <- HongKong_sentences %>%
unnest_tokens(word, sentence, token = HongKong_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE) %>%
rename(count=n)
# 清理斷詞結果:挑出總出現次數大於3的字
reserved_word <- HongKong_tokens %>%
group_by(word) %>%
count() %>%
filter(n > 3) %>%
unlist()
HongKong_removed <- HongKong_tokens %>%
filter(word %in% reserved_word)
# 將資料轉換為 Document Term Matrix (DTM)
HongKong_dtm <- HongKong_removed %>% cast_dtm(artUrl, word, count)
HongKong_dtm
## <<DocumentTermMatrix (documents: 9168, terms: 19996)>>
## Non-/sparse entries: 717069/182606259
## Sparsity : 100%
## Maximal term length: 14
## Weighting : term frequency (tf)
# LDA分成 10 個主題
#HongKong_lda <- LDA(HongKong_dtm, k = 10, control = list(seed = 1234))
#save(HongKong_lda, file = "HongKong_lda_result")
load("HongKong_lda_result")
# 看各群的常用詞彙
tidy(HongKong_lda, matrix = "beta") %>%
filter(!term %in% c("台灣","中國")) %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
mutate(topic = as.factor(topic), term = reorder_within(term, beta, topic)) %>%
ggplot(aes(term, beta, fill = topic)) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip() +
scale_x_reordered()
topic_name = c("武漢肺炎", "美國法案", "港警鎮壓", "民主自由", "none", "none2", "國安法", "移民", "遊行示威", "香港政府")
# 主題分布
tmResult <- posterior(HongKong_lda)
doc_pro <- tmResult$topics
dim(doc_pro)
## [1] 9168 10
# get document topic proportions
document_topics <- doc_pro[HongKong$artUrl,]
document_topics_df =data.frame(document_topics)
colnames(document_topics_df) = topic_name
rownames(document_topics_df) = NULL
news_topic = cbind(HongKong,document_topics_df)
news_topic %>%
dplyr::select(-commentNum,-push,-boo) %>%
group_by(artDate = format(artDate,'%Y%m')) %>%
summarise_if(is.numeric, sum, na.rm = TRUE) %>%
melt(id.vars = "artDate") %>%
ggplot( aes(x=artDate, y=value, fill=variable)) +
geom_bar(stat = "identity") + ylab("value") +
scale_fill_manual(values=mycolors) +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
去除 none 主題和資料較少的月份
news_topic %>%
filter( !format(artDate,'%Y%m') %in% c(201912,202001,202002,202003,202004)) %>%
dplyr::select(-none, -none2, -commentNum, -push, -boo) %>%
group_by(artDate = format(artDate,'%Y%m')) %>%
summarise_if(is.numeric, sum, na.rm = TRUE) %>%
melt(id.vars = "artDate")%>%
ggplot( aes(x=artDate, y=value, fill=variable)) +
geom_bar(stat = "identity") + ylab("value") +
scale_fill_manual(values=mycolors) +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
將上圖以比例方式比較
news_topic %>%
filter( !format(artDate,'%Y%m') %in% c(201912,202001,202002,202003,202004)) %>%
dplyr::select(-none, -none2, -commentNum, -push, -boo) %>%
group_by(artDate = format(artDate,'%Y%m')) %>%
summarise_if(is.numeric, sum, na.rm = TRUE) %>%
melt(id.vars = "artDate")%>%
group_by(artDate) %>%
mutate(total_value =sum(value))%>%
ggplot( aes(x=artDate, y=value/total_value, fill=variable)) +
geom_bar(stat = "identity") + ylab("proportion") +
scale_fill_manual(values=mycolors) +
theme(axis.text.x = element_text(angle = 90, hjust = 1))
我們透過 github 線上 demo LDAvis 的結果:
LDAvis結果連結
# 使用LDA預測每篇文章的主題
HongKong_topics <- tidy(HongKong_lda, matrix = "gamma") %>% # 在tidy function中使用參數"gamma"來取得 theta矩陣。
group_by(document) %>%
top_n(1, wt=gamma)
# 把文章資訊和主題join起來
posts_Reviews_LDA <- merge(x = posts_Reviews, y = HongKong_topics, by.x = "artUrl", by.y = "document")
# 文章主題歸類為3(港警鎮壓)、7(國安法)
# 欄位只取:cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)
link1 <- posts_Reviews_LDA %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>10) %>%
ungroup() %>%
filter(topic == 3 | topic == 7) %>%
select(cmtPoster, artPoster, artUrl, topic) %>%
unique()
link1
## # A tibble: 313 x 4
## cmtPoster artPoster artUrl topic
## <chr> <chr> <chr> <int>
## 1 Strokes LWong https://www.ptt.cc/bbs/Gossiping/M.1563144183.A… 3
## 2 hTCU11 LWong https://www.ptt.cc/bbs/Gossiping/M.1563144183.A… 3
## 3 armorblocks Retangle https://www.ptt.cc/bbs/Gossiping/M.1563721157.A… 3
## 4 ymuit Retangle https://www.ptt.cc/bbs/Gossiping/M.1563721157.A… 3
## 5 lost0816 Rossini https://www.ptt.cc/bbs/Gossiping/M.1563733562.A… 3
## 6 mudee Rossini https://www.ptt.cc/bbs/Gossiping/M.1563733562.A… 3
## 7 winnie759281 okah https://www.ptt.cc/bbs/Gossiping/M.1563775744.A… 3
## 8 myyalga Moogle https://www.ptt.cc/bbs/Gossiping/M.1563780974.A… 3
## 9 bbcocomo asuka99 https://www.ptt.cc/bbs/Gossiping/M.1563785669.A… 3
## 10 sinon0123 namtar https://www.ptt.cc/bbs/Gossiping/M.1563789249.A… 3
## # … with 303 more rows
# 篩選link中有出現的使用者
filtered_user1 <- userList %>%
filter(user%in%link1$cmtPoster | user%in%link1$artPoster) %>%
arrange(desc(type))
# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link1, v=filtered_user1, directed=F)
# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
# 依據回覆發生的文章所對應的主題,對他們的關聯線上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$topic == "3", "coral3", "cyan3")
# 畫出社群網路圖
set.seed(5432)
plot(reviewNetwork, vertex.size=3, edge.width=2, vertex.label.dist=1,
vertex.label=ifelse(degree(reviewNetwork) > 7, V(reviewNetwork)$label, NA),vertex.label.font=4)
# 加入標示
legend("topleft", c("發文者","回文者"), pch=21,
col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=1)
legend("bottomright", c("港警鎮壓","國安法"),
col=c("coral3","cyan3"), lty=1, cex=0.6)
- 可以找出「港警鎮壓」主題的主要發文者有:gaucher, cjim322, Jpswd, good2009
- 可以找出「國安法」主題的主要發文者有:omanorboyo, lovea
我們進一步分析「港警鎮壓」的主要發文者:
發文頻率比較
HongKong_leader1 = HongKong %>% filter(artPoster=="gaucher")
HongKong_leader2 = HongKong %>% filter(artPoster=="cjim322")
HongKong_leader3 = HongKong %>% filter(artPoster=="Jpswd")
HongKong_leader4 = HongKong %>% filter(artPoster=="rayGG")
# 綜合比較
HongKong_leader1$artDate = as.Date(HongKong_leader1$artDate)
HongKong_leader1= HongKong_leader1 %>% mutate(months = as.Date(cut(artDate, "months")))
HongKong_leader1time = HongKong_leader1 %>% group_by(months) %>%
summarise(num=n()) %>% as.data.frame %>%
mutate(poster ="gaucher")
HongKong_leader2$artDate = as.Date(HongKong_leader2$artDate)
HongKong_leader2= HongKong_leader2 %>% mutate(months = as.Date(cut(artDate, "months")))
HongKong_leader2time = HongKong_leader2 %>% group_by(months) %>%
summarise(num=n()) %>% as.data.frame %>%
mutate(poster ="cjim322")
HongKong_leader3$artDate = as.Date(HongKong_leader3$artDate)
HongKong_leader3= HongKong_leader3 %>% mutate(months = as.Date(cut(artDate, "months")))
HongKong_leader3time = HongKong_leader3 %>% group_by(months) %>%
summarise(num=n()) %>% as.data.frame %>%
mutate(poster ="Jpswd")
HongKong_leader4$artDate = as.Date(HongKong_leader4$artDate)
HongKong_leader4= HongKong_leader4 %>% mutate(months = as.Date(cut(artDate, "months")))
HongKong_leader4time = HongKong_leader4 %>% group_by(months) %>%
summarise(num=n()) %>% as.data.frame %>%
mutate(poster ="rayGG")
# 整合發文趨勢圖
HongKong_leader = rbind(HongKong_leader1time, HongKong_leader2time, HongKong_leader3time, HongKong_leader4time)
HongKong_leader %>% ggplot(aes(x= months,y=num,fill=poster)) +geom_bar(stat = "identity")+
facet_wrap(~poster, ncol = 2, scales = "fixed")
可以發現雖然有些人的發文數不多,但卻在PTT上引起很大的討論。我們進一步分析 gaucher 這位發文數最多的作者。
發文熱度
plot_date <-
# data
HongKong_leader1 %>%
# aesthetics
ggplot(aes(x = artDate, y = commentNum)) +
# geometrics
geom_line(color = "#00AFBB", size = 1) +
# coordinates
scale_x_date(labels) +
ggtitle("gaucher 文章的回覆數") +
xlab("日期") +
ylab("發文數")
plot_date
可以看出他發文引起高度討論聲量的時段和反送中高熱度時段幾乎吻合
# 發文的標題
HongKong %>%
filter(artPoster=="gaucher") %>%
select(artTitle, artDate)
## artTitle artDate
## 1 [爆卦]香港地盤工人也反了 2019-07-25
## 2 [爆卦]香港連律政司政府律師也反了 2019-07-26
## 3 [爆卦]中國微博對香港示威開始轉風向了 2019-08-14
## 4 [爆卦]香港今日集會可能再破人數紀錄 2019-08-17
## 5 Re:[爆卦]香港抗議青年收隊受整間商場歡呼 2019-08-25
## 6 Re:[新聞]林鄭月娥:不設獨立調查委員會不接受反 2019-08-27
## 7 [爆卦]港府:行政長官個人看法與政府立場無關 2019-08-28
## 8 [爆卦]香港立法會議員也被捕了 2019-08-30
## 9 [爆卦]香港立法會議員再多一人被捕 2019-08-30
## 10 [爆卦]環時總編到港大戰香港才子live 2019-09-01
## 11 Re:[爆卦]香港旺角站關閉太子站持續關閉 2019-09-07
## 12 [爆卦]香港昨天完美示範警黑合作的最高境界 2019-09-15
## 13 [新聞]香港警方:「我們正被推向極限」 2019-09-22
## 14 [爆卦]香港打死人當自殺的証據浮出水面? 2019-09-23
## 15 [爆卦]香港獅子山率先賀國慶:習總一死以謝天下 2019-09-26
## 16 Re:[新聞]香港海關搜反送中裝備全面檢查台灣旅客 2019-09-28
## 17 [爆卦]香港警察的專業克制今天全世界都看到了 2019-09-29
## 18 Re:[問卦]香港抗議是不是高房租高房價造成的 2019-10-01
## 19 Re:[新聞]集會戴口罩有罪?!港媒稱新法違者恐入獄 2019-10-03
## 20 Re:[新聞]禁蒙面激怒火「香港臨時政府」成立 2019-10-05
## 21 Re:[問卦]為何香港、澳門兩樣情? 2019-10-05
## 22 Re:[爆卦]香港屯門老人持刀跟年輕人示威最後下場 2019-10-05
## 23 [爆卦]烏克蘭親俄恐怖組織發圖支持香港警察 2019-10-07
## 24 [爆卦]香港中環已聚集十萬以上人潮 2019-10-14
## 25 [爆卦]香港溺斃少女案件10月15日進展 2019-10-14
## 26 Re:[問卦]香港舔共第一人是誰? 2019-10-18
## 27 Re:[問卦]香港是不是又和平啦? 2019-10-22
## 28 [爆卦]英國務大臣確認收到香港一家庭被自殺求助 2019-10-25
## 29 Re:[新聞]黃之鋒參加香港區議會號次抽籤被抬走 2019-10-25
## 30 Re:[問卦]香港只剩一小撮人在抗議? 2019-10-30
## 31 Re:[爆卦]今夜香港再次濺血 2019-11-10
## 32 Re:[爆卦]港警進攻香港各大學,下令直接射擊頭部 2019-11-11
## 33 Re:[爆卦]港警進攻香港各大學,下令直接射擊頭部 2019-11-12
## 34 Re:[爆卦]香港被撤離中生要求撤下官媒不實報導 2019-11-13
## 35 [爆卦]香港大角咀墮樓案(不是爆頭那宗) 2019-11-15
## 36 Re:[爆卦]香港理大戰況最新更新 2019-11-17
## 37 Re:[問卦]香港兩高院法官是否腦殘竟敢釋憲? 2019-11-18
## 38 [爆卦]香港監警會聘外國專家寫報告今集體請辭 2019-12-10
## 39 Re:[新聞]港媒痛批:民進黨冷血吃香港人豆腐! 2019-12-12
## 40 Re:[新聞]預備取代香港習近平將宣布澳門發展為金 2019-12-15
## 41 Re:[問卦]香港最後怎麼了? 2019-12-20
## 42 Re:[新聞]巧固球國際賽!香港隊抗議台灣使用國旗 2019-12-20
## 43 Re:[問卦]香港人真的是被自殺嗎? 2020-01-01
## 44 [爆卦]香港HMV推「警察陣亡」電影系列兼送香檳 2020-03-02
## 45 [爆卦]香港區議員用揚聲器令警耳痛今襲警罪成 2020-04-06
文字雲
HongKong_sentences_leader1 <- strsplit(HongKong_leader1$sentence,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
HongKong_sentences_leader1 <- data.frame(
artUrl = rep(HongKong_leader1$artUrl, sapply(HongKong_sentences_leader1, length)),
sentence = unlist(HongKong_sentences_leader1)) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
HongKong_sentences_leader1$sentence <- as.character(HongKong_sentences_leader1$sentence)
# 使用斷詞引擎,放入要用的詞典和停用字
jieba_tokenizer = worker(user="detention_lexicon.txt", stop_word = "stop_words.txt", write = "NOFILE")
chi_tokenizer <- function(t) {
lapply(t, function(x) {
if(nchar(x)>1){
tokens <- segment(x, jieba_tokenizer)
tokens <- tokens[nchar(tokens)>1]
return(tokens)
}
})
}
# 進行斷詞,並計算各詞彙在各文章中出現的次數
HongKong_words_leader1 <- HongKong_sentences_leader1 %>%
unnest_tokens(word, sentence, token=chi_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
# 畫出文字雲
#HongKong_words_leader1 %>%
# group_by(word) %>%
# summarise(sum = n()) %>%
# filter(sum > 2) %>%
# arrange(desc(sum)) %>%
# wordcloud2()
由發文的文章標題和文字雲中,可以再度驗證這個人主要在討論港警鎮壓的話題
# 篩選條件:
# 1. 2019/10/01至2020/01/01的文章
# 2. 有在10篇以上文章回覆者,
# 3. 文章主題歸類為8(移民)與10(香港政府)者,
# 4. 欄位只取:cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)
link <- posts_Reviews_LDA %>%
filter(artDate > as.Date('2019-10-01')) %>%
filter(artDate < as.Date('2020-01-01')) %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>15) %>%
ungroup() %>%
filter(topic == 8 | topic == 10) %>%
select(cmtPoster, artPoster, artUrl, topic) %>%
unique()
link
## # A tibble: 193 x 4
## cmtPoster artPoster artUrl topic
## <chr> <chr> <chr> <int>
## 1 kbten Diaw19 https://www.ptt.cc/bbs/Gossiping/M.1570072730.A… 8
## 2 lasekoutkast Diaw19 https://www.ptt.cc/bbs/Gossiping/M.1570072730.A… 8
## 3 ahaha777 Diaw19 https://www.ptt.cc/bbs/Gossiping/M.1570072730.A… 8
## 4 todao todao https://www.ptt.cc/bbs/Gossiping/M.1570083820.A… 8
## 5 Floramom1224 todao https://www.ptt.cc/bbs/Gossiping/M.1570083820.A… 8
## 6 Gon legos4710 https://www.ptt.cc/bbs/Gossiping/M.1570208726.A… 8
## 7 todao closky https://www.ptt.cc/bbs/Gossiping/M.1570210988.A… 8
## 8 psl7634 psl7634 https://www.ptt.cc/bbs/Gossiping/M.1570221662.A… 8
## 9 dieorrun psl7634 https://www.ptt.cc/bbs/Gossiping/M.1570221662.A… 8
## 10 gordan123 ben780413 https://www.ptt.cc/bbs/Gossiping/M.1570329194.A… 8
## # … with 183 more rows
# 篩選link中有出現的使用者
filtered_user <- userList %>%
filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
arrange(desc(type))
# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=F)
# 依據使用者身份對點上色
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
# 依據回覆發生的文章所對應的主題,對他們的關聯線上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$topic == "8", "coral3", "cyan3")
# 畫出社群網路圖
set.seed(5000)
plot(reviewNetwork, vertex.size=6, edge.arrow.size=.2, edge.width=2,
vertex.label=ifelse(degree(reviewNetwork) > 8, V(reviewNetwork)$label, NA),vertex.label.font=2)
# 加入標示
legend("bottomright", c("發文者","回文者"), pch=21, col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("移民", "香港政府"), col=c("coral3","cyan3"), lty=1, cex=1)
可以找出「移民」主題的主要發文者有:johnny790218, todao
進一步分析發文者 johnny790218:一共只發表四篇文章
HongKong_leader9 = HongKong %>% filter(artPoster=="johnny790218")
summary(HongKong_leader9)
## artTitle artDate artTime artUrl
## Length:4 Min. :2019-09-02 Length:4 Length:4
## Class :character 1st Qu.:2019-09-26 Class :character Class :character
## Mode :character Median :2019-11-05 Mode :character Mode :character
## Mean :2019-12-09
## 3rd Qu.:2020-01-19
## Max. :2020-05-24
## artPoster artCat commentNum push
## Length:4 Length:4 Min. : 89.0 Min. : 34.00
## Class :character Class :character 1st Qu.: 168.5 1st Qu.: 43.75
## Mode :character Mode :character Median : 200.5 Median : 68.00
## Mean : 492.8 Mean :174.50
## 3rd Qu.: 524.8 3rd Qu.:198.75
## Max. :1481.0 Max. :528.00
## boo sentence
## Min. : 17.00 Length:4
## 1st Qu.: 41.75 Class :character
## Median : 79.50 Mode :character
## Mean :122.75
## 3rd Qu.:160.50
## Max. :315.00
進一步分析發文者 johnny790218:一共發表四十六篇文
HongKong_leader10 = HongKong %>% filter(artPoster=="todao")
summary(HongKong_leader10)
## artTitle artDate artTime artUrl
## Length:46 Min. :2019-07-15 Length:46 Length:46
## Class :character 1st Qu.:2019-09-04 Class :character Class :character
## Mode :character Median :2019-10-15 Mode :character Mode :character
## Mean :2019-10-27
## 3rd Qu.:2019-11-22
## Max. :2020-05-25
## artPoster artCat commentNum push
## Length:46 Length:46 Min. : 2.00 Min. : 0.00
## Class :character Class :character 1st Qu.: 15.00 1st Qu.: 4.00
## Mode :character Mode :character Median : 25.50 Median : 6.50
## Mean : 92.78 Mean : 27.70
## 3rd Qu.: 54.25 3rd Qu.: 15.25
## Max. :1425.00 Max. :448.00
## boo sentence
## Min. : 0.000 Length:46
## 1st Qu.: 0.000 Class :character
## Median : 1.000 Mode :character
## Mean : 8.435
## 3rd Qu.: 4.750
## Max. :220.000
HongKong_sentences_leader10 <- strsplit(HongKong_leader10$sentence,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
HongKong_sentences_leader10 <- data.frame(
artUrl = rep(HongKong_leader10$artUrl, sapply(HongKong_sentences_leader10, length)),
sentence = unlist(HongKong_sentences_leader10)) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
HongKong_sentences_leader10$sentence <- as.character(HongKong_sentences_leader10$sentence)
# 使用斷詞引擎,放入要用的詞典和停用字
jieba_tokenizer = worker(user="detention_lexicon.txt", stop_word = "stop_words.txt", write = "NOFILE")
chi_tokenizer <- function(t) {
lapply(t, function(x) {
if(nchar(x)>1){
tokens <- segment(x, jieba_tokenizer)
tokens <- tokens[nchar(tokens)>1]
return(tokens)
}
})
}
# 進行斷詞,並計算各詞彙在各文章中出現的次數
HongKong_words_leader10 <- HongKong_sentences_leader10 %>%
unnest_tokens(word, sentence, token=chi_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
# 畫出文字雲
#HongKong_words_leader10 %>%
# group_by(word) %>%
# summarise(sum = n()) %>%
# filter(sum > 5) %>%
# arrange(desc(sum)) %>%
# wordcloud2()
觀察文字雲的結果,johnny790218 文章有向國際傾斜的情勢,反送中被視為一個國際問題
# 篩選條件:
# 1. 2020/05/01後的文章
# 2. 有在10篇以上文章回覆者,
# 3. 文章主題歸類為7(國安法)與8(移民)者,
# 4. 欄位只取:cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)
link <- posts_Reviews_LDA %>%
filter(artDate > as.Date('2020-05-01')) %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>10) %>%
ungroup() %>%
filter(topic == 7 | topic == 8) %>%
select(cmtPoster, artPoster, artUrl, topic) %>%
unique()
link
## # A tibble: 139 x 4
## cmtPoster artPoster artUrl topic
## <chr> <chr> <chr> <int>
## 1 slimfat0202 blue999 https://www.ptt.cc/bbs/Gossiping/M.1589985536… 8
## 2 gordan123 blue999 https://www.ptt.cc/bbs/Gossiping/M.1589985536… 8
## 3 gaddafi blue999 https://www.ptt.cc/bbs/Gossiping/M.1589985536… 8
## 4 edc3 blue999 https://www.ptt.cc/bbs/Gossiping/M.1589985536… 8
## 5 KillerMoDo alicevvn https://www.ptt.cc/bbs/Gossiping/M.1590007049… 8
## 6 fleetindark alicevvn https://www.ptt.cc/bbs/Gossiping/M.1590007049… 8
## 7 watashiD DengXiaoPing https://www.ptt.cc/bbs/Gossiping/M.1590072754… 8
## 8 KillerMoDo DengXiaoPing https://www.ptt.cc/bbs/Gossiping/M.1590072754… 8
## 9 kinmengon DengXiaoPing https://www.ptt.cc/bbs/Gossiping/M.1590072754… 8
## 10 aaronfv DengXiaoPing https://www.ptt.cc/bbs/Gossiping/M.1590072754… 8
## # … with 129 more rows
# 篩選link中有出現的使用者
filtered_user <- userList %>%
filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
arrange(desc(type))
# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=F)
# 依據使用者身份對點上色
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
# 依據回覆發生的文章所對應的主題,對他們的關聯線上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$topic == "7", "coral3", "cyan3")
# 畫出社群網路圖
set.seed(5000)
plot(reviewNetwork, vertex.size=6, edge.arrow.size=.2, edge.width=2,
vertex.label=ifelse(degree(reviewNetwork) > 5, V(reviewNetwork)$label, NA),vertex.label.font=2)
# 加入標示
legend("bottomright", c("發文者","回文者"), pch=21, col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("國安法", "移民"), col=c("coral3","cyan3"), lty=1, cex=1)
可以找出主要發文者有:lovea, sam930114
進一步分析發文者 lovea:
HongKong_leader7 = HongKong %>% filter(artPoster=="lovea")
HongKong_leader7 %>%
select(artDate,commentNum)
## artDate commentNum
## 1 2019-09-21 21
## 2 2020-05-22 817
## 3 2020-05-23 16
# 找出他發表的文章
HongKong_leader7 %>% select(artTitle)
## artTitle
## 1 [問卦]香港街頭很容易碰到明星嗎??
## 2 [新聞]快訊/總統府:「港版國安法」對香港民主
## 3 [問卦]香港很像會錯正妹意的肥宅?
他在5月22日轉載了一篇新聞:快訊/總統府:「港版國安法」對香港民主自由造成威脅
# 觀察回覆次數
HongKong_review4 = HongKong_review2 %>% filter(cmtPoster=="lovea") %>% select(artTitle, cmtContent)
HongKong_review4
## artTitle
## 1 [問卦]不刪統一今日香港明日台灣?
## 2 [新聞]坐爆北車!港生高唱《願榮光歸香港》
## cmtContent
## 1 :剛上任沒空啦2023年底再來好嗎
## 2 :香港韭菜已經沒利用價值了快滾回去我們已經完全執政了
他一共只參與了兩篇文章的回覆。
進一步分析發文者 sam930114:
HongKong_leader8 = HongKong %>% filter(artPoster=="sam930114")
summary(HongKong_leader8)
## artTitle artDate artTime artUrl
## Length:1 Min. :2020-05-24 Length:1 Length:1
## Class :character 1st Qu.:2020-05-24 Class :character Class :character
## Mode :character Median :2020-05-24 Mode :character Mode :character
## Mean :2020-05-24
## 3rd Qu.:2020-05-24
## Max. :2020-05-24
## artPoster artCat commentNum push
## Length:1 Length:1 Min. :1445 Min. :691
## Class :character Class :character 1st Qu.:1445 1st Qu.:691
## Mode :character Mode :character Median :1445 Median :691
## Mean :1445 Mean :691
## 3rd Qu.:1445 3rd Qu.:691
## Max. :1445 Max. :691
## boo sentence
## Min. :283 Length:1
## 1st Qu.:283 Class :character
## Median :283 Mode :character
## Mean :283
## 3rd Qu.:283
## Max. :283
這個人也是只發了一篇文章就造成非常大的討論聲量
# 找出他發表的文章
HongKong_leader8 %>% select(artTitle)
## artTitle
## 1 [新聞]快訊/蔡英文:這一刻,我們都和香港人
也是透過轉發新聞的方式引起很大的討論聲量,他在5月24日轉載了新聞:快訊/蔡英文:這一刻,我們都和香港人民站在一起
HongKong_review5 = HongKong_review2 %>% filter(cmtPoster=="sam930114") %>% select(artTitle, cmtContent)
HongKong_review5
## [1] artTitle cmtContent
## <0 rows> (or 0-length row.names)
這個人從來沒有在PTT上面回覆過文章。
# 把回覆類型為箭頭的回覆移除
link <- posts_Reviews %>%
filter(cmtStatus!="→") %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>10) %>%
ungroup() %>%
select(cmtPoster, artPoster, artUrl, cmtStatus) %>%
unique()
# 篩選link中有出現的使用者
filtered_user <- userList %>%
filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
arrange(desc(type))
# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=F)
# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
# 依據回覆發生的文章所對應的主題,對他們的關聯線進行上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$cmtStatus == "推", "lightgreen", "palevioletred")
# 畫出社群網路圖
set.seed(487)
plot(reviewNetwork, vertex.size=5, edge.arrow.size=.2, edge.width=3,
vertex.label=ifelse(degree(reviewNetwork) > 5, V(reviewNetwork)$label, NA),vertex.label.font=2)
# 加入標示
legend("bottomright", c("發文者","回文者"), pch=21, col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("推","噓"), col=c("lightgreen","palevioletred"), lty=1, cex=1)
可以看出關於反送中的文章有推有噓,但推文佔多數。我們進一步分析 ckbdfrst 這位作者
HongKong_leader5 = HongKong %>% filter(artPoster=="ckbdfrst")
summary(HongKong_leader5)
## artTitle artDate artTime artUrl
## Length:47 Min. :2019-07-26 Length:47 Length:47
## Class :character 1st Qu.:2019-08-21 Class :character Class :character
## Mode :character Median :2019-09-23 Mode :character Mode :character
## Mean :2019-09-26
## 3rd Qu.:2019-11-12
## Max. :2019-11-30
## artPoster artCat commentNum push
## Length:47 Length:47 Min. : 1.00 Min. : 1.00
## Class :character Class :character 1st Qu.: 11.50 1st Qu.: 4.50
## Mode :character Mode :character Median : 22.00 Median : 10.00
## Mean : 59.49 Mean : 36.49
## 3rd Qu.: 59.50 3rd Qu.: 23.00
## Max. :695.00 Max. :446.00
## boo sentence
## Min. : 0.000 Length:47
## 1st Qu.: 0.000 Class :character
## Median : 1.000 Mode :character
## Mean : 3.064
## 3rd Qu.: 4.000
## Max. :26.000
共發了47篇文,最多的一篇文有695則回覆。
發文熱度
plot_date <-
# data
HongKong_leader5 %>%
# aesthetics
ggplot(aes(x = artDate, y = commentNum)) +
# geometrics
geom_line(color = "#00AFBB", size = 1) +
# coordinates
scale_x_date(labels) +
ggtitle("ckbdfrst 文章的回覆數") +
xlab("日期") +
ylab("發文數")
plot_date
# 發文的標題
HongKong %>%
filter(artPoster=="ckbdfrst") %>%
select(artTitle, artDate)
## artTitle artDate
## 1 [新聞]批香港民陣中國外交部:勾結外部勢力沒好 2019-07-26
## 2 [新聞]反送中再寫歷史光復元朗成新界史上最壯觀 2019-07-27
## 3 Re:[問卦]香港民主??? 2019-07-27
## 4 [新聞]撇中聯辦反送中港人突襲遊行至銅鑼灣[影] 2019-07-28
## 5 [新聞]港運動員連署挺反送中:香港是否仍令我們 2019-07-29
## 6 [新聞]中國外交部:反送中是美方作品欠世界一個 2019-07-30
## 7 [新聞]輸不起轉生氣中國少年冰球隊員群毆香港隊 2019-08-01
## 8 [新聞]香港政局掀罵戰中美連續兩天互批不停嘴 2019-08-09
## 9 [問卦]媒體不公香港撐警活動怎麼不報導? 2019-08-12
## 10 [新聞]新華社羅織反送中頭目名單黃之鋒黎智英等 2019-08-13
## 11 Re:[爆卦]英國總領事館派人進駐香港機場 2019-08-15
## 12 Re:[新聞]台灣將供香港人道救援國台辦超不爽:罔 2019-08-19
## 13 [新聞]香港人鏈28英里手牽手要求民主 2019-08-24
## 14 [新聞]美國會山紀念「波羅的海之路」聲援香港 2019-08-25
## 15 Re:[問卦]跟香港人說香港=中國,香港人爆氣的卦? 2019-08-29
## 16 [新聞]疑似美國人遭香港警察逮捕原因不明 2019-09-01
## 17 [新聞]使館人員反制反送中過激立陶宛召見中國大 2019-09-02
## 18 [新聞]遮打花園民眾祈福高呼「驅逐共黨光復香港 2019-09-08
## 19 [問卦]有沒有香港新國歌【願榮光歸香港】的8卦? 2019-09-10
## 20 Re:[新聞]「願榮光歸香港」反送中新神曲響徹港島 2019-09-12
## 21 [新聞]穆迪調降香港信用評級林鄭月娥:不認同 2019-09-17
## 22 [新聞]香港反送中運動百日民間訴求轉向驅逐中共 2019-09-18
## 23 [新聞]反送中遊行屯門登場示威者扯下五星旗焚燒 2019-09-21
## 24 [新聞]反送中訴求反極權929串聯全球遊行 2019-09-23
## 25 [新聞]柏林牆倒塌30年德國人挺香港反中共 2019-09-29
## 26 [新聞]中共十一香港山頭現「結束一黨專政」橫幅 2019-10-01
## 27 [爆卦]香港連登仔再譜新曲《不屈進行曲》 2019-10-03
## 28 [新聞]挺香港快閃活動中山連儂隧道百人高歌 2019-10-04
## 29 [新聞]香港特首評分再創新低 2019-10-08
## 30 [爆卦]香港警方發言人被爆正在申請美國綠卡 2019-10-09
## 31 [問卦]香港黑警被錄下最中國口音的影片是這個嗎? 2019-10-11
## 32 [新聞]美參議員親歷反送中籲重審北京奧運主辦權 2019-10-18
## 33 [新聞]中學生:若因為怕不站出來香港就完了 2019-10-20
## 34 Re:[新聞]港警開火放3槍:西灣河1人重傷,香港1111大三罷鎮壓 2019-11-11
## 35 [問卦]請問香港人聽到獅子山下會感動嗎? 2019-11-12
## 36 Re:[爆卦]香港警察準備進攻中文大學 2019-11-12
## 37 [問卦]香港中大警民衝突光是命名就對虫國不利??? 2019-11-13
## 38 [新聞]救香港 美委員會建議國會立法嚇阻解放軍 2019-11-15
## 39 [新聞]中共竟要求馬國媒體寫「中國包括台灣香港 2019-11-16
## 40 [新聞]港人齊聚劍橋示威要求撤銷林鄭月娥榮譽院 2019-11-17
## 41 Re:[問卦]看到香港直播很傷心正常嗎?? 2019-11-17
## 42 [問卦]虫國人請進。請問香港大學裏沒好人嗎? 2019-11-17
## 43 [新聞]香港理大警民衝突美官員:譴責不合理使用 2019-11-18
## 44 [問卦]嗆等著看香港選舉的中國人現在到哪去了?! 2019-11-25
## 45 [新聞]川普簽香港法案前發硬漢圖片網民:看懂了 2019-11-28
## 46 [新聞]中國創新捲共諜疑雲悄關子公司未通報香港 2019-11-29
## 47 [新聞]廣東火葬場惹議停建示威輿論猛cue香港反 2019-11-30
文字雲
HongKong_sentences_leader5 <- strsplit(HongKong_leader5$sentence,"[。!;?!?;]")
# 將每個句子與所屬的文章連結配對起來,整理成 dataframe
HongKong_sentences_leader5 <- data.frame(
artUrl = rep(HongKong_leader5$artUrl, sapply(HongKong_sentences_leader5, length)),
sentence = unlist(HongKong_sentences_leader5)) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
HongKong_sentences_leader5$sentence <- as.character(HongKong_sentences_leader5$sentence)
# 使用斷詞引擎,放入要用的詞典和停用字
jieba_tokenizer = worker(user="detention_lexicon.txt", stop_word = "stop_words.txt", write = "NOFILE")
chi_tokenizer <- function(t) {
lapply(t, function(x) {
if(nchar(x)>1){
tokens <- segment(x, jieba_tokenizer)
tokens <- tokens[nchar(tokens)>1]
return(tokens)
}
})
}
# 進行斷詞,並計算各詞彙在各文章中出現的次數
HongKong_words_leader5 <- HongKong_sentences_leader5 %>%
unnest_tokens(word, sentence, token=chi_tokenizer) %>%
filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
count(artUrl, word, sort = TRUE)
# 畫出文字雲
#HongKong_words_leader5 %>%
# group_by(word) %>%
# summarise(sum = n()) %>%
# filter(sum > 5) %>%
# arrange(desc(sum)) %>%
# wordcloud2()
由發文標題和文字雲可以看出,這個人的文章大多與中國政府有關,有可能是藉助反送中來表達對中國政府的不滿
主題意見領袖的發文數量有兩種情況:有些發文數在40至50篇之間,有些只有極少的發文數。
那麼發文數極少的人是如何有大量的回覆量的呢?我們觀察他們的回覆時間與回覆數,發現這些人主要是轉載一篇爆炸性的新聞引起高度討論聲量,或是長期潛伏在PTT內,只參與反送中議題討論而不發表文章。
然而對於發文數多的人,我們畫出了他們的文字雲,發現他們在這段期間的發文具有極高的傾向性,一個人發的文章主要只涉及一個主題。 例如港警鎮壓這個主題中的主要發文者,在文字雲中「港警」這個詞非常突出。
最後,在反送中的三大事件中,從發文意見領袖的角度看,元朗事件和禁蒙面法是獨立於國安法之外的,因為前二者的主要發文領袖通常很少參與國安法的討論(很少在2020年後發表回復),僅有一人(gaucher)全時段活躍。而國安法的兩個主要發文者也從來沒有參與過前面的討論。
透過這次的分析,我們發現在 PTT 上反送中的討論聲量除了今年1月至3月較低之外,一直以來都有滿高的討論度,其中有幾個事件的發生特別引起極大的討論,包含「元朗事件」、「禁止蒙面條例」、「港警入侵大學」、「發布國安法」等等,從情緒分析的結果來看,網友對於這些事件皆抱持負面的態度。
進一步分析網友的發文及回覆內容,我們發現在反送中的討論中主要存在幾個議題,包含「港警鎮壓」、「民主自由」、「移民」、「遊行示威」和「香港政府」等等,不同的時間點通常會有不同的討論主題。
此外我們也透過「社群網路圖」找出一些能夠引起高度討論聲量的發文者,並進一步去分析這些意見領袖的特質,例如哪些人特別活耀在某些主題的討論上。