第十四周：社群網路分析礁藻議題
第3組讀書會 林子紘 B074020021 彭璿祐 B064020029 徐明暇 D084020002 劉晉瑋 M094020006 洪玟君 M094020030 林永盛M094020042
系統參數設定
Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼## [1] ""安裝需要的packages
packages = c("readr", "dplyr", "jiebaR", "tidyr", "tidytext", "igraph", "topicmodels", "ggplot2", "stringr")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)讀進library
library(readr)
library(dplyr)
library(jiebaR)
library(tidyr)
library(tidytext)
library(igraph)
library(topicmodels)
library(stringr)
library(ggplot2)
library(reshape2)
library(wordcloud2)
require(RColorBrewer)
mycolors <- colorRampPalette(brewer.pal(8, "Set3"))(20)資料基本介紹
- 資料來源: 文字平台收集PTT hatePolitics政黑版/Gossip八卦版文章、回覆
- 資料集： Corrected_articleMetaData.csv、Corrected_articleReviews.csv
- 關鍵字：藻礁、三接、陳昭倫、潘忠政
- 資料時間：2021-01-01~2021-05-26
這次本組以PTT版的藻礁議題為主題，有別於之前以新聞為資料來源：
1. 資料前處理
在本篇分析中，我們希望建構特定議題的社群網路圖，並分析網路中討論的議題主題
我們需要兩種資料： (1) 每篇文章的主題分類(LDA) (2) 社群網路圖的link和nodes
載入文章和網友回覆資料
posts <- read_csv("../data/reef_ptt_articleMetaData.csv") %>% # 文章 1090
mutate(sentence=gsub("[\n]{2,}", "。", sentence)) %>%
mutate(sentence=gsub("\n", "", sentence)) %>% #換行符號
mutate(sentence=gsub("http(s)?[-:\\/A-Za-z0-9\\.]+", " ", sentence)) %>% #有url的取代掉
mutate(sentence=gsub("媒體來源|記者署名|完整新聞標題|完整新聞內文|完整新聞連結|(或短網址)|備註|備註請放最後面|違者新聞文章刪除|最後更新", "", sentence))
reviews <- read_csv("../data/reef_ptt_articleReviews.csv") # 回覆 54276
# head(posts)
# head(reviews)2.LDA 主題分類
文章斷詞
jieba_tokenizer = worker(user="../dict/reef_dict.txt", stop_word = "../dict/reef_stop_words.txt")
news_tokenizer <- function(t) {
lapply(t, function(x) {
if(nchar(x)>1){
tokens <- segment(x, jieba_tokenizer)
# 去掉字串長度爲1的詞彙
tokens <- tokens[nchar(tokens)>1]
return(tokens)
}
})
}斷詞結果可以先存起來，就不用再重跑一次
# tokens <- posts %>%
# mutate(sentence = gsub("[[:punct:]]", "",sentence)) %>%
# mutate(sentence = gsub("[0-9a-zA-Z]", "",sentence)) %>%
# unnest_tokens(word, sentence, token=news_tokenizer) %>%
# count(artUrl, word) %>%
# rename(count=n)
# tokens
# save.image(file = "../data/reef_token_result.rdata")load("../data/reef_token_result.rdata")清理斷詞結果
。根據詞頻，選擇只出現3字以上的字 。整理成url,word,n的格式之後，就可以轉dtm
P.S. groupby by之後原本的字詞結構會不見，把詞頻另存在一個reserved_word裡面
# 依據字頻挑字
reserved_word <- tokens %>%
group_by(word) %>%
count() %>%
filter(n > 3) %>% #詞頻>3的詞彙
unlist()
reef_removed <- tokens %>%
filter(word %in% reserved_word) #tokens保留>3的word
#reef_dtm 裡面 nrow:幾篇文章 ; ncol:幾個字, 轉成dtm
reef_dtm <- reef_removed %>% cast_dtm(artUrl, word, count) (2) LDA 主題分析
將剛處理好的dtm放入LDA函式分析
# LDA分成5個主題
# reef_lda <- LDA(reef_dtm, k = 5, control = list(seed = 123))
reef_lda <- LDA(reef_dtm, k =5, control = list(seed = 2021,alpha = 10,delta=0.2),method = "Gibbs")p.s. 。tidy(mask_lda, matrix = “beta”) # 取字 topic term beta值 。tidy(mask_lda, matrix=“gamma”) # 取主題 document topic gamma
取出代表字詞(term)
removed_word = c("藻礁","裡面","不是","每天","出來","覺得")
reef_term_topic<- tidy(reef_lda, matrix = "beta")
# 看各群的常用詞彙
tidy(reef_lda, matrix = "beta") %>% # 取出topic term beta值
filter(! term %in% removed_word) %>%
group_by(topic) %>%
top_n(15, beta) %>% # beta值前15的字
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()
可以歸納出
phi_m <- reef_term_topic %>% arrange(desc(beta)) %>% top_n(80) #取前100 beta最大值 ## Selecting by betadtm <-phi_m %>% cast_dtm(topic, term, beta)
dtmm<-as.matrix(dtm)
dim(dtmm) ## [1] 5 66network=graph_from_incidence_matrix(dtmm)
# plot
set.seed(3)
plot(network, ylim=c(-1,1), xlim=c(-1,1), asp = 0,
vertex.label.cex=0.7, vertex.size=10, vertex.label.family = "Heiti TC Light")## Warning in text.default(x, y, labels = labels, col = label.color, family =
## label.family, : font family not found in Windows font database
各topic的主要字詞，其中民進黨、國民黨與2個topic均有關連 ,此議題已由環保議題轉為政治議題
取出代表主題(topic)
每篇文章拿gamma值最大的topic當該文章的topic
# 在tidy function中使用參數"gamma"來取得 theta矩陣
reef_doc_topic<- tidy(reef_lda, matrix = "gamma")
reef_topics <- tidy(reef_lda, matrix="gamma") %>% # document topic gamma
group_by(document) %>%
top_n(1, wt=gamma) #gamma值最大者
# reef_topics %>% filter(gamma>0.5) %>% arrange(desc(gamma)) #141筆
table(reef_topics$topic ) #各主題的分佈情形 ##
## 1 2 3 4 5
## 168 189 210 412 189資料內容探索
posts_topic <- merge(x = posts, y = reef_topics, by.x = "artUrl", by.y="document") #增加post的Url
# 看一下各主題在說甚麼
set.seed(123)
# t1<-
# posts_topic %>% # 主題一
# filter(topic==1) %>%
# select(artTitle,sentence,artDate) %>%
# unique()
# t2<-
# posts_topic %>% # 主題一
# filter(topic==2) %>%
# select(artTitle,sentence,artDate) %>%
# unique()
# t3<-
# posts_topic %>% # 主題一
# filter(topic==3) %>%
# select(artTitle,sentence,artDate) %>%
# unique()
# t4<-
# posts_topic %>% # 主題一
# filter(topic==4) %>%
# select(artTitle,sentence,artDate) %>%
# unique()
# t5<-
# posts_topic %>% # 主題一
# filter(topic==5) %>%
# select(artTitle,sentence,artDate) %>%
# unique()
# posts_topic %>% # 主題一
# filter(topic==1) %>%
# select(artTitle,sentence,artDate) %>%
# unique() %>%
# sample_n(20)
#
# posts_topic %>% # 主題二
# filter(topic==2) %>%
# select(artTitle,sentence) %>%
# unique() %>%
# sample_n(20)
#
# posts_topic %>% # 主題三
# filter(topic==3) %>%
# select(artTitle,sentence) %>%
# unique() %>%
# sample_n(20)
#
# posts_topic %>% # 主題四
# filter(topic==4) %>%
# select(artTitle,sentence) %>%
# unique() %>%
# sample_n(20)
#
# posts_topic %>% # 主題五
# filter(topic==5) %>%
# select(artTitle,sentence) %>%
# unique() %>%
# sample_n(20)為各主題命名：
主題一：環團領銜人潘忠政相關討論，如「潘忠政被爆經手7千萬藻礁保育預算網問」、「潘忠政臉書疑隱射同志遭停權?王浩宇自首」、「潘忠政帳號被限制藍委籲臉書勿介入台灣」、「見蔡英文前潘忠政首度與藍會」
主題二：「中油天然氣第三接收站開發或替代方案，如「藻礁公投若擋下三接王美花：減煤成績恐倒退」、「蘇揆評估三接外推潘忠政：不會退讓」、「三接若換地點洪孟楷：反對移到八里台北」
主題三：珍愛藻礁公投連署 主題多為藻礁公投連署訴求及衝刺連署書的活動， 「搶救大潭藻礁公投連署告急環團倒數8天」、「西門町再掀「徵乾爹」風潮大學生為藻礁」藻礁公投逾70萬份連署書送中選會環團
主題四：「護礁與能源議題，歸為主題4的發文數最多，如連帶討論護藻礁即表示支持重啟核四等論戰。「藻礁政治化？藍加入連署,綠諷為“重啟核四”」、「保留藻礁你家斷電你同意嗎三接？」、「別再帶風向了，台灣根本不缺電 沒三接也不會缺電是真假的？」、「因為一片藻礁全台停電大家願意嗎？」
主題五：桃園政府民眾對藻礁生態保護/開發意向之議題，如「藻礁公投連署破61萬鄭文燦：喊沉重」、「保育藻礁曾把鄭文燦當戰友」、「藻礁生態早被工業污染毒死 里長：只剩礁了,大潭里里長彭振添說」、「大潭藻礁的生物多 樣性真的有如環團所說的這麼高嗎？會不會被誇大論述？」
日期主題分布
畫出每月topic的分布，在1月時幾乎沒有人知道此議題，2月底爆量討論 在各議題的討論分布上，發現隨著時間增加，主題二、的比例逐漸增加。
主題二：中油天然氣第三接收站開發或替代方案，於5/3 政院所提的三接外推方案，佔比增加
主題三：珍愛藻礁公投連署，因3月中後已過連署人數，討論比例逐月減少
主題四：護礁與能源議題比例一直很高
#看每月的發文數
# posts_topic %>%
# mutate(artDate = as.Date(artDate)) %>%
# filter(topic=='4',format(artDate,'%Y%m')=="202102")
#
# a1= posts_topic %>%
# mutate(artDate = as.Date(artDate)) %>%
# count(artDate= format(artDate,'%Y%m'),topic)
#
# a2= posts_topic %>%
# mutate(artDate = as.Date(artDate)) %>%
# group_by(artDate= format(artDate,'%Y%m'),topic) %>%
# summarise(sum =sum(topic))
posts %>%
mutate(artDate = as.Date(artDate)) %>%
group_by(artDate) %>%
summarise(count = n())%>%
ggplot(aes(artDate,count))+
geom_line(color="red")+
geom_point()
#看每月的發文數
posts_topic %>%
mutate(artDate = as.Date(artDate)) %>%
count(artDate= format(artDate,'%Y%m'),topic) %>%
ggplot(aes(x= artDate,y=n,fill=as.factor(topic))) +
geom_col() 
#依每月topic的分佈，以比例呈現
posts_topic %>%
mutate(artDate = as.Date(artDate)) %>%
group_by(artDate= format(artDate,'%Y%m'),topic) %>%
summarise(sum =sum(topic)) %>%
ggplot(aes(x= artDate,y=sum,fill=as.factor(topic))) +
geom_col(position="fill") ## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.
#八卦板,政黑板各主題的比例
posts_topic %>%
group_by(artCat,topic) %>% #加入板別
summarise(sum = n()) %>%
ggplot(aes(x= artCat,y=sum,fill=as.factor(topic))) +
geom_col(position="dodge")## `summarise()` has grouped output by 'artCat'. You can override using the `.groups` argument.
4. 社群網路圖
資料合併
# 文章和留言
reviews <- reviews %>%
select(artUrl, cmtPoster, cmtStatus, cmtContent)
posts_Reviews <- merge(x = posts, y = reviews, by = "artUrl") #用artUrl merge posts 和reviews
# 看一下最近自導自演的林瑋豐先生是否有留言--嘲諷: "兩岸一家親,到福州有什麼不對"
posts_Reviews %>%
filter(artPoster %in% c("bj26bj","hahalalor") | cmtPoster %in% c("bj26bj","hahalalor")) %>%
select (cmtPoster,cmtContent) ## cmtPoster cmtContent
## 1 bj26bj :兩岸一家親,到福州有什麼不對# 把文章和topic
posts_Reviews <- merge(x = posts_Reviews, y = reef_topics, by.x = "artUrl", by.y="document")
head(posts_Reviews,3)## artUrl
## 1 https://www.ptt.cc/bbs/Gossiping/M.1610188174.A.1A3.html
## 2 https://www.ptt.cc/bbs/Gossiping/M.1610188174.A.1A3.html
## 3 https://www.ptt.cc/bbs/Gossiping/M.1610188174.A.1A3.html
## artTitle artDate artTime artPoster
## 1 [新聞]籲保護藻礁生態陳椒華︰時力黨部將響應 2021-01-09 10:29:31 ueewen
## 2 [新聞]籲保護藻礁生態陳椒華︰時力黨部將響應 2021-01-09 10:29:31 ueewen
## 3 [新聞]籲保護藻礁生態陳椒華︰時力黨部將響應 2021-01-09 10:29:31 ueewen
## artCat commentNum push boo
## 1 Gossiping 25 6 0
## 2 Gossiping 25 6 0
## 3 Gossiping 25 6 0
## sentence
## 1 1.:自由時報。2.:吳書緯。3.:籲保護藻礁生態 陳椒華︰時力黨部將響應珍愛藻礁公投連署。4.:。面對和，恐因能源轉型所進行的開發遭受破壞，民眾黨立委邱臣遠和時代力量黨主席、立委陳椒華今共同呼籲，政府應針對能源轉型政策說清楚目標，謙卑傾聽人民聲音；陳椒華更宣布，時力全台各地黨部將會響應「珍愛藻礁」公投連署，保護藻礁生態。。環團今在立院舉行「公民的海洋公民 救藻礁公投 搶救外木山／大潭藻礁與基隆珊瑚聯合抗爭」記者會；珍愛藻礁公投領銜人潘忠政指出，這是搶救大潭藻礁第122次記者會，也是和基隆守護珊瑚團體合作的第一次記者會。。陳椒華表示，桃園大潭電廠的天然氣第三接收站將破壞7000年歷史的藻礁和柴山多杯孔珊瑚，而基隆外木三的協和電廠第四接收站要填海造陸18.6公頃，將淹埋7萬多株珊瑚，也無視當地的保育類綠蠵龜和玳瑁龜。。對此，陳椒華表示，為了擴張天然氣接收站，破壞豐富的自然資源和海洋生態，對於生態有強烈衝擊，能源轉型的目標不該只放在2025年，更應對2050年長遠規劃，不斷檢視大型發電廠發電成本和電網問題，並規畫有效的節電政策，讓再生能源成為發電主力，因此不一定需要在桃園觀塘設置三接以及基隆外木山填海造陸。。基隆出身的邱臣遠表示，能源轉型與環境、海洋生態並不是二元對立，能源轉型需要不斷的與社會溝通，站在國家能源政策的立場，原則支持燃油改燃氣，但台電與經濟部應該更主動、謙卑溝通，並針對各界的疑慮說清楚。。此外，邱臣遠也質疑，協和電廠按規畫要到2027年才會完全商轉，但能源轉型的政策，未來10、20年能源轉型的目標到底是什麼，以及天然氣發電未來的占比，台電和經濟部能源局在去年底立法院能遠轉型公聽會都沒有辦法具體回答。。時代力量基隆市議員陳薇仲表示，陳薇仲感嘆，「民進黨政府對海洋議題是無聲回應嗎」，呼籲民進黨要正視能源轉型議題，採取各種方案來降低對生態的破壞，趕快做出檢討，否則「向海致敬」只會變空虛的口號。。無黨籍基隆市議員王醒之說，無論是中油觀塘三接、協和火力發電廠四接、北方三島離岸風電的共同特色，就是「能源轉型之名，行環境不義之實」，能源轉型到頭來也是要回到跟生態環境之間做選擇的老路，這樣的轉型有正義可言嗎？過去半世紀來，台灣能源開發都是這個舊的邏輯，能源轉型必須要有新的思維，他也在提出協和電廠可設置永久浮動是馬頭（FSRU）作為填海造陸替代方案。。海洋學者陳昭倫指出，桃園大潭藻礁和基隆外木山的珊瑚群聚，代表台灣西北海岸最為珍貴的兩個獨特、命運相連的生態系；外木山的珊瑚群聚在氣候變遷衝擊下也是生物重要的庇護所。。5. (): :。
## 2 1.:自由時報。2.:吳書緯。3.:籲保護藻礁生態 陳椒華︰時力黨部將響應珍愛藻礁公投連署。4.:。面對和，恐因能源轉型所進行的開發遭受破壞，民眾黨立委邱臣遠和時代力量黨主席、立委陳椒華今共同呼籲，政府應針對能源轉型政策說清楚目標，謙卑傾聽人民聲音；陳椒華更宣布，時力全台各地黨部將會響應「珍愛藻礁」公投連署，保護藻礁生態。。環團今在立院舉行「公民的海洋公民 救藻礁公投 搶救外木山／大潭藻礁與基隆珊瑚聯合抗爭」記者會；珍愛藻礁公投領銜人潘忠政指出，這是搶救大潭藻礁第122次記者會，也是和基隆守護珊瑚團體合作的第一次記者會。。陳椒華表示，桃園大潭電廠的天然氣第三接收站將破壞7000年歷史的藻礁和柴山多杯孔珊瑚，而基隆外木三的協和電廠第四接收站要填海造陸18.6公頃，將淹埋7萬多株珊瑚，也無視當地的保育類綠蠵龜和玳瑁龜。。對此，陳椒華表示，為了擴張天然氣接收站，破壞豐富的自然資源和海洋生態，對於生態有強烈衝擊，能源轉型的目標不該只放在2025年，更應對2050年長遠規劃，不斷檢視大型發電廠發電成本和電網問題，並規畫有效的節電政策，讓再生能源成為發電主力，因此不一定需要在桃園觀塘設置三接以及基隆外木山填海造陸。。基隆出身的邱臣遠表示，能源轉型與環境、海洋生態並不是二元對立，能源轉型需要不斷的與社會溝通，站在國家能源政策的立場，原則支持燃油改燃氣，但台電與經濟部應該更主動、謙卑溝通，並針對各界的疑慮說清楚。。此外，邱臣遠也質疑，協和電廠按規畫要到2027年才會完全商轉，但能源轉型的政策，未來10、20年能源轉型的目標到底是什麼，以及天然氣發電未來的占比，台電和經濟部能源局在去年底立法院能遠轉型公聽會都沒有辦法具體回答。。時代力量基隆市議員陳薇仲表示，陳薇仲感嘆，「民進黨政府對海洋議題是無聲回應嗎」，呼籲民進黨要正視能源轉型議題，採取各種方案來降低對生態的破壞，趕快做出檢討，否則「向海致敬」只會變空虛的口號。。無黨籍基隆市議員王醒之說，無論是中油觀塘三接、協和火力發電廠四接、北方三島離岸風電的共同特色，就是「能源轉型之名，行環境不義之實」，能源轉型到頭來也是要回到跟生態環境之間做選擇的老路，這樣的轉型有正義可言嗎？過去半世紀來，台灣能源開發都是這個舊的邏輯，能源轉型必須要有新的思維，他也在提出協和電廠可設置永久浮動是馬頭（FSRU）作為填海造陸替代方案。。海洋學者陳昭倫指出，桃園大潭藻礁和基隆外木山的珊瑚群聚，代表台灣西北海岸最為珍貴的兩個獨特、命運相連的生態系；外木山的珊瑚群聚在氣候變遷衝擊下也是生物重要的庇護所。。5. (): :。
## 3 1.:自由時報。2.:吳書緯。3.:籲保護藻礁生態 陳椒華︰時力黨部將響應珍愛藻礁公投連署。4.:。面對和，恐因能源轉型所進行的開發遭受破壞，民眾黨立委邱臣遠和時代力量黨主席、立委陳椒華今共同呼籲，政府應針對能源轉型政策說清楚目標，謙卑傾聽人民聲音；陳椒華更宣布，時力全台各地黨部將會響應「珍愛藻礁」公投連署，保護藻礁生態。。環團今在立院舉行「公民的海洋公民 救藻礁公投 搶救外木山／大潭藻礁與基隆珊瑚聯合抗爭」記者會；珍愛藻礁公投領銜人潘忠政指出，這是搶救大潭藻礁第122次記者會，也是和基隆守護珊瑚團體合作的第一次記者會。。陳椒華表示，桃園大潭電廠的天然氣第三接收站將破壞7000年歷史的藻礁和柴山多杯孔珊瑚，而基隆外木三的協和電廠第四接收站要填海造陸18.6公頃，將淹埋7萬多株珊瑚，也無視當地的保育類綠蠵龜和玳瑁龜。。對此，陳椒華表示，為了擴張天然氣接收站，破壞豐富的自然資源和海洋生態，對於生態有強烈衝擊，能源轉型的目標不該只放在2025年，更應對2050年長遠規劃，不斷檢視大型發電廠發電成本和電網問題，並規畫有效的節電政策，讓再生能源成為發電主力，因此不一定需要在桃園觀塘設置三接以及基隆外木山填海造陸。。基隆出身的邱臣遠表示，能源轉型與環境、海洋生態並不是二元對立，能源轉型需要不斷的與社會溝通，站在國家能源政策的立場，原則支持燃油改燃氣，但台電與經濟部應該更主動、謙卑溝通，並針對各界的疑慮說清楚。。此外，邱臣遠也質疑，協和電廠按規畫要到2027年才會完全商轉，但能源轉型的政策，未來10、20年能源轉型的目標到底是什麼，以及天然氣發電未來的占比，台電和經濟部能源局在去年底立法院能遠轉型公聽會都沒有辦法具體回答。。時代力量基隆市議員陳薇仲表示，陳薇仲感嘆，「民進黨政府對海洋議題是無聲回應嗎」，呼籲民進黨要正視能源轉型議題，採取各種方案來降低對生態的破壞，趕快做出檢討，否則「向海致敬」只會變空虛的口號。。無黨籍基隆市議員王醒之說，無論是中油觀塘三接、協和火力發電廠四接、北方三島離岸風電的共同特色，就是「能源轉型之名，行環境不義之實」，能源轉型到頭來也是要回到跟生態環境之間做選擇的老路，這樣的轉型有正義可言嗎？過去半世紀來，台灣能源開發都是這個舊的邏輯，能源轉型必須要有新的思維，他也在提出協和電廠可設置永久浮動是馬頭（FSRU）作為填海造陸替代方案。。海洋學者陳昭倫指出，桃園大潭藻礁和基隆外木山的珊瑚群聚，代表台灣西北海岸最為珍貴的兩個獨特、命運相連的生態系；外木山的珊瑚群聚在氣候變遷衝擊下也是生物重要的庇護所。。5. (): :。
## cmtPoster cmtStatus cmtContent topic gamma
## 1 popy8789 推 :4%實力不夠不要大小聲 2 0.3396825
## 2 yoyodiy → :唱過夢醒時分就以為自己很強？管到海邊去喔 2 0.3396825
## 3 eecoolty → :時力反核反媒反天然氣他們到底要啥來發電？ 2 0.3396825取出 cmtPoster(回覆者)、artPoster(發文者)、artUrl(文章連結) 三個欄位
link <- posts_Reviews %>% select(cmtPoster, artPoster, artUrl)
head(link,3) #欄位的順序有關係 ## cmtPoster artPoster artUrl
## 1 popy8789 ueewen https://www.ptt.cc/bbs/Gossiping/M.1610188174.A.1A3.html
## 2 yoyodiy ueewen https://www.ptt.cc/bbs/Gossiping/M.1610188174.A.1A3.html
## 3 eecoolty ueewen https://www.ptt.cc/bbs/Gossiping/M.1610188174.A.1A3.html基本網路圖
建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, directed=T)
reviewNetwork## IGRAPH 0f62a2b DN-- 8883 56658 --
## + attr: name (v/c), artUrl (e/c)
## + edges from 0f62a2b (vertex names):
## [1] popy8789 ->ueewen yoyodiy ->ueewen eecoolty ->ueewen
## [4] james732 ->ueewen jeffmib ->ueewen ams9 ->ueewen
## [7] ams9 ->ueewen vicious666->ueewen vicious666->ueewen
## [10] vicious666->ueewen vicious666->ueewen vicious666->ueewen
## [13] vicious666->ueewen vicious666->ueewen ab4daa ->ueewen
## [16] ams9 ->ueewen ams9 ->ueewen KG10525 ->ueewen
## [19] ssisters ->ueewen ssisters ->ueewen ssisters ->ueewen
## [22] KG10525 ->ueewen sggs ->ueewen Smile ->ueewen
## + ... omitted several edges直接畫的話，因為點沒有經過篩選，看起來會密密麻麻的 還需要經過一次資料篩選，有興趣可以跑跑下面的code
# 畫出網路圖(密集恐懼警告)
#plot(reviewNetwork)
#plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,vertex.label=NA)資料篩選
資料篩選的方式：
- 文章:文章日期、留言數(commentNum)
- link、node:degree
# 看一下留言數大概都多少(方便後面篩選)
# 留言數最高有到900多個留言
posts %>%
filter(commentNum > 100) %>%
ggplot(aes(x=commentNum)) + geom_histogram() ## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
依據發文數或回覆數篩選post和review
# # 帳號發文篇數 , 發文數都在20篇下
post_count = posts %>%
group_by(artPoster) %>%
summarise(count = n()) %>%
arrange(desc(count))
post_count## # A tibble: 540 x 2
## artPoster count
## <chr> <int>
## 1 JamesSoong 21
## 2 chirex 17
## 3 nightwing 17
## 4 devidevi 16
## 5 GV13 16
## 6 iamalam2005 16
## 7 linchadwick 15
## 8 Gavatzky 13
## 9 googolplex 13
## 10 aaaba 11
## # ... with 530 more rows#
# # 帳號回覆總數
review_count = reviews %>%
group_by(cmtPoster) %>%
summarise(count = n()) %>%
arrange(desc(count))
review_count## # A tibble: 8,693 x 2
## cmtPoster count
## <chr> <int>
## 1 spzper 487
## 2 cisyong 305
## 3 iamalam2005 289
## 4 vicious666 271
## 5 elainakuo 261
## 6 Robben 223
## 7 brepus 219
## 8 tenfu 214
## 9 Anvec 206
## 10 gogen 204
## # ... with 8,683 more rows# # 發文者
poster_filtered <- post_count %>% filter(count >= 2) #共184位 發文超過2篇
posts <- posts %>% filter(posts$artPoster %in% poster_filtered$artPoster) #找出發文超過2篇的posts
# # 回覆者
reviewer_filtered <- review_count %>% filter(count >= 20) #564位
reviews <- reviews %>% filter(reviews$cmtPoster %in% reviewer_filtered$cmtPoster)# 檢視參與人數
length(unique(posts_Reviews$artPoster)) # 發文者數量 533## [1] 533length(unique(posts_Reviews$cmtPoster)) # 回覆者數量 8693## [1] 8693allPoster <- c(posts_Reviews$artPoster, posts_Reviews$cmtPoster) # 總參與人數 8883
length(unique(allPoster))## [1] 8883標記所有出現過得使用者
- poster：只發過文、發過文+留過言
- replier：只留過言
userList <- data.frame(user=unique(allPoster)) %>%
mutate(type=ifelse(user%in%posts$artPoster, "poster", "replier"))
head(userList,3)## user type
## 1 ueewen replier
## 2 qazsedcft poster
## 3 HsuGun poster先探討八卦版篩選社群,留言數超過一定數量者
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>% #同一篇文章留言超過3次
filter(commentNum > 300) %>%
filter(artCat=="Gossiping") %>%
select(cmtPoster, artPoster, artUrl) %>%
unique()
link## # A tibble: 297 x 3
## # Groups: cmtPoster, artUrl [297]
## cmtPoster artPoster artUrl
## <chr> <chr> <chr>
## 1 coffee112 wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 2 spzper wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 3 Tiphareth wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 4 konanno1 wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 5 meta41110 wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 6 PHXD wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 7 cocabell wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 8 aglet wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 9 Skydier wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## 10 nike00000000 wizardfizban https://www.ptt.cc/bbs/Gossiping/M.1614209900.A.79~
## # ... with 287 more rows篩選在link裡面有出現的使用者
filtered_user <- userList %>%
filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
arrange(desc(type))
head(filtered_user,10)## user type
## 1 hitsukix replier
## 2 alan0204 replier
## 3 Skydier replier
## 4 Tiphareth replier
## 5 roex0608 replier
## 6 plzza0cats replier
## 7 socialism replier
## 8 fact replier
## 9 polanco replier
## 10 jk182325 replierp.s.想要看會變怎麼樣的人可以跑下面的code
## 警告！有密集恐懼症的人請小心使用
v = userList
reviewNetwork <- graph_from_data_frame(d=link, v=userList, directed=T)
plot(reviewNetwork, vertex.size=3, edge.arrow.size=0.3,vertex.label=NA)
因爲圖片箭頭有點礙眼，所以這裏我們先把關係的方向性拿掉，減少圖片中的不必要的資訊 set.seed 因為igraph呈現的方向是隨機的
set.seed(487)
# v=filtered_user
reviewNetwork = degree(reviewNetwork) > 25
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=F)
plot(reviewNetwork, vertex.size=3, edge.arrow.size=0.3,vertex.label=NA)
加上nodes的顯示資訊
用使用者的身份來區分點的顏色
- poster:gold(有發文)
- replier:lightblue(只有回覆文章)
set.seed(487)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "orange", "lightblue")
plot(reviewNetwork, vertex.size=4, edge.arrow.size=0.3,vertex.label=NA)
可以稍微看出圖中的點(人)之間有一定的關聯，不過目前只有單純圖形我們無法分析其中的內容。
因此以下我們將資料集中的資訊加到我們的圖片中。
為點加上帳號名字，用degree篩選要顯示出的使用者，以免圖形被密密麻麻的文字覆蓋
filter_degree = 10
set.seed(123)
# 設定 node 的 label/ color
labels <- degree(reviewNetwork) # 算出每個點的degree
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "orange", "lightblue")
plot(
reviewNetwork,
vertex.size=4,
edge.width=1,
vertex.label.dist=1,
vertex.label=ifelse(degree(reviewNetwork) > filter_degree, V(reviewNetwork)$label, NA),vertex.label.font=2)
我們可以看到基本的使用者關係，但是我們希望能夠將更進階的資訊視覺化。
例如：使用者經常參與的文章種類，或是使用者在該社群網路中是否受到歡迎。
以主題篩選社群
主題二：中油天然氣第三接收站開發或替代方案，於5/3 政院所提的三接外推方案，佔比增加
主題三：珍愛藻礁公投連署，因3月中後已過連署人數，討論比例逐月減少
主題四：護礁與能源議題比例一直很高
篩選一篇文章回覆3次以上者，且文章留言數多於200則， 文章主題歸類為2(三接收站開發或替代方案) 3(珍愛藻礁公投連署)與4(護礁與能源議題)者， 欄位只取：cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 200) %>%
filter(topic == "2" | topic == "3" |topic == "4" ) %>%
select(cmtPoster, artPoster, artUrl, topic) %>%
unique()
link## # A tibble: 322 x 4
## # Groups: cmtPoster, artUrl [290]
## cmtPoster artPoster artUrl topic
## <chr> <chr> <chr> <int>
## 1 Aggro Oisiossos https://www.ptt.cc/bbs/Gossiping/M.1613894790.A.45~ 3
## 2 qazsedcft Oisiossos https://www.ptt.cc/bbs/Gossiping/M.1613894790.A.45~ 3
## 3 kaet Oisiossos https://www.ptt.cc/bbs/Gossiping/M.1613894790.A.45~ 3
## 4 ohdada Oisiossos https://www.ptt.cc/bbs/Gossiping/M.1613894790.A.45~ 3
## 5 ccekw807 Oisiossos https://www.ptt.cc/bbs/Gossiping/M.1613894790.A.45~ 3
## 6 hydralee Oisiossos https://www.ptt.cc/bbs/Gossiping/M.1613894790.A.45~ 3
## 7 serrier Oisiossos https://www.ptt.cc/bbs/Gossiping/M.1613894790.A.45~ 3
## 8 nikewang DsLove710 https://www.ptt.cc/bbs/Gossiping/M.1614166502.A.08~ 4
## 9 ntusimmon DsLove710 https://www.ptt.cc/bbs/Gossiping/M.1614166502.A.08~ 4
## 10 ohdada DsLove710 https://www.ptt.cc/bbs/Gossiping/M.1614166502.A.08~ 4
## # ... with 312 more rows- 抓nodes 在所有的使用者裡面，篩選link中有出現的使用者
filtered_user <- userList %>%
filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
arrange(desc(type))
head(filtered_user,3)## user type
## 1 Oisiossos replier
## 2 hitsukix replier
## 3 alan0204 replier使用者經常參與的文章種類
filter_degree = 6
# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=F)
# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork)
# labels
V(reviewNetwork)$label <- names(labels) #label的名稱為poster,replier的PTT ID ...
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "orange", "lightblue") #節點的顏色
# V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
# 依據回覆發生的文章所對應的"主題"，對他們的關聯線進行上色
E(reviewNetwork)$color <-
ifelse(E(reviewNetwork)$topic == "1", "palevioletred",
ifelse(E(reviewNetwork)$topic == "2", "lightgreen",
ifelse(E(reviewNetwork)$topic == "3", "lightgray",
ifelse(E(reviewNetwork)$topic == "4", "lightblue",
"lightyellow"
) ) ))
# 畫出社群網路圖(degree>7的才畫出來)
set.seed(5432)
plot(reviewNetwork, vertex.size=4, edge.width=2, vertex.label.dist=1,
vertex.label=ifelse(degree(reviewNetwork) > filter_degree, V(reviewNetwork)$label, NA),vertex.label.font=1)
# 加入標示
legend("bottomright", c("發文者","回文者"), pch=21,
col="#777777", pt.bg=c("orange","lightblue"), pt.cex=1, cex=1)
# legend("topleft", c("TOPIC_1","TOPIC_2","TOPIC_3","TOPIC_4","TOPIC_5"),
# col=c("palevioletred", "lightgreen","lightgray","lightblue", "lightyellow"), lty=1, cex=1)
# 2(三接收站開發或替代方案) 3(珍愛藻礁公投連署) 與4(護礁與能源議題)
legend("topleft", c("第三接收站方案","珍愛藻礁公投連署","護礁與能源議題"),
col=c("lightgreen", "lightgray","lightblue"), lty=1, cex=1)
> voshi412, akuan413, mystage主要為發文連署議題
Hyuui 為護礁與能源議題
shinmoner, sunchen0201 第三接收站開發或替代方案
使用者是否受到歡迎
八卦版 PTT的回覆有三種，推文、噓文、箭頭，我們只要看推噓就好，因此把箭頭清掉，這樣資料筆數較少，所以我們把篩選的條件放寬一些。
filter_degree = 6 # 使用者degree
# 過濾留言者對發文者的推噓程度
link <- posts_Reviews %>%
filter(artCat=="Gossiping") %>%
filter(commentNum > 150) %>%
filter(cmtStatus!="→") %>%
group_by(cmtPoster, artUrl) %>%
filter( n() > 2) %>%
ungroup() %>%
select(artTitle,sentence,cmtContent, cmtPoster, artPoster, artUrl, cmtStatus) %>%
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", "orange", "lightblue")
# 依據回覆發生的文章所對應的推噓狀態，對他們的關聯線進行上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$cmtStatus == "推", "lightgreen", "palevioletred")
# 畫出社群網路圖
set.seed(180)
plot(reviewNetwork, vertex.size=5, edge.width=1, vertex.label.dist=1,
vertex.label=ifelse(degree(reviewNetwork) > filter_degree, V(reviewNetwork)$label, NA),vertex.label.font=1)
# 加入標示
legend("bottomright", c("發文者","回文者"), pch=21,
col="#777777", pt.bg=c("orange","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("推","噓"),
col=c("lightgreen","palevioletred"), lty=1, cex=1)
#2個中心帳號的PO文內容
link %>% filter(artPoster %in% c("akuan413","shinmoner")) %>%
inner_join(posts) %>%
select (cmtPoster,artPoster,artTitle,cmtStatus,artUrl) ## Joining, by = c("artPoster", "artUrl")## # A tibble: 24 x 5
## cmtPoster artPoster artTitle cmtStatus artUrl
## <chr> <chr> <chr> <chr> <chr>
## 1 zeroBB akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 2 zeumax akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 3 winiS akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 4 talrasha akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 5 zego41 akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 6 cisyong akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 7 showingst~ akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 8 Tako55 akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 9 sam8921502 akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## 10 blessbless akuan413 [爆卦]長老教會暫~ 推 https://www.ptt.cc/bbs/Goss~
## # ... with 14 more rows八卦版中的討論中以推文較多、噓文較少
akuan413的發文 https://www.ptt.cc/bbs/Gossiping/M.1614431357.A.3E0.html (長老教會支持連署被關切) 獲得多的推文
shinmoner的發文,表藻礁公投若過 學者：藻礁與中南部民眾的肺恐擇一，得到噓聲多
探索政黑版 PTT的回覆
filter_degree = 6 # 使用者degree
# 過濾留言者對發文者的推噓程度
link <- posts_Reviews %>%
filter(artCat=="HatePolitics") %>%
filter(commentNum > 100) %>%
filter(cmtStatus!="→") %>%
group_by(cmtPoster, artUrl) %>%
filter( n() > 2) %>%
ungroup() %>%
select(artTitle,sentence,cmtContent, cmtPoster, artPoster, artUrl, cmtStatus) %>%
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", "orange", "lightblue")
# 依據回覆發生的文章所對應的推噓狀態，對他們的關聯線進行上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$cmtStatus == "推", "lightgreen", "palevioletred")
# 畫出社群網路圖
set.seed(5432)
plot(reviewNetwork, vertex.size=5, edge.width=3, vertex.label.dist=1,
vertex.label=ifelse(degree(reviewNetwork) > filter_degree, V(reviewNetwork)$label, NA),vertex.label.font=2)
# 加入標示
legend("bottomright", c("發文者","回文者"), pch=21,
col="#777777", pt.bg=c("orange","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("推","噓"),
col=c("lightgreen","palevioletred"), lty=1, cex=1)
> 政黑版中的意見領袖“推”文中較八卦版多為多
主要有 linhu8883324, qazsedcft, osalucard, ismail,mystage
補充：networkD3
需要設定每個節點的id，記得要從0開始
library(networkD3)## Warning: package 'networkD3' was built under R version 4.0.5links = link
nodes = filtered_user
nodes$id = 0:(length(nodes$user) - 1) #node id從0開始
# 整理資料格式
nodes_complete <- data.frame(nodeID = unique(c(links$cmtPoster, links$artPoster)))
nodes_complete$group <- nodes$type[match(nodes_complete$nodeID, nodes$user)] #link裡的artPoster,cmtPoster有match到filtered_user的userID, 的type 取出放入group欄位
links$source <- match(links$cmtPoster, nodes_complete$nodeID) - 1
links$target <- match(links$artPoster, nodes_complete$nodeID) - 1
# 畫圖
library(networkD3)
forceNetwork(Links = links, Nodes = nodes_complete, Source = "source",
Target = "target", NodeID = "nodeID", Group = "group",
opacity = 0.8, fontSize = 10, zoom = TRUE,legend = TRUE, opacityNoHover = TRUE,
colourScale = "d3.scaleOrdinal(d3.schemeCategory10);",
linkColour = ifelse(links$cmtStatus == "推", "palegreen","lightcoral") # 設定推噓顏色
)## Links is a tbl_df. Converting to a plain data frame.總結
一、主題討論度：
1.中油天然氣第三接收站開發或替代方案，於5/3 政院所提的三接外推方案，佔比增加
2.珍愛藻礁公投連署，因3月中後已過連署人數，討論比例逐月減少
3.護礁與能源議題比例一直很高
二、討論熱度最高者為護礁與能源議題比例，已由環保議題變成政治議題，包括主要的藍綠及其它政黨政治人物的發言，也可看到帶風向的討論，比如支持護礁，即表示是支持核能，是支持重啟核四，又如保護藻礁就會缺電等討論。
三、當昇化為政治議題時，有關抹黑造謠的八卦就隨之而起，包括前桃園市議員王浩宇質疑潘忠政與台電6800萬保育藻礁工程有所牽連
四、八卦版的意見領袖的討論中，以推文較多、噓文較少
1. akuan413的發文 https://www.ptt.cc/bbs/Gossiping/M.1614431357.A.3E0.html (長老教會支持連署被關切) 獲得多的推文
2. shinmoner的發文,https://www.ptt.cc/bbs/Gossiping/M.1614874587.A.3D5.html (表藻礁公投若過學者：藻礁與中南部民眾的肺恐擇一)，得到噓聲多，可見鄉民仍有其判斷
五、政黑版的意見領袖的討論中，推文較八卦版意見領袖的推文多
六、同義字詞的清理如珍愛公投、珍愛公投連署、藻礁公投等，三接、中油天然氣第三接收站、第三接收站等，可再進一步做彙整