社群網路分析大潭藻礁事件
第三組
組員: + 林子紘 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)資料基本介紹
- 資料來源: 文字平台收集PTT 政黑版版、八卦版文章、回覆
- 資料集： reef_article.csv、reef_reviews.csv
- 關鍵字：藻礁、三接、陳昭倫、潘忠政
- 資料時間：2021/01/01-2021/05/26
這次我們針對3月發生的大潭藻礁事件，討論ptt版上相關討論的發文風向，主要針對以下方向分析：
1.大潭藻礁的討論重點有哪些? 主要分為哪幾種風向? 2.目前風向最偏哪邊? 3.討論大潭藻礁的社群網路如何分布? 4.大潭藻礁的意見領袖有誰?網友的推噓狀態如何?
1. 資料前處理
在本篇分析中，我們希望建構特定議題的社群網路圖，並分析網路中討論的議題主題
我們需要兩種資料： (1) 每篇文章的主題分類(LDA) (2) 社群網路圖的link和nodes
載入文章和網友回覆資料
#posts <- read_csv("./data/reef_article.csv") # 文章 1090
#reviews <- read_csv("./data/reef_reviews.csv") # 回覆 54276
#head(posts)
#head(reviews)2.LDA 主題分類
文章斷句
# 文章斷句("\n\n"取代成"。")
#reef_meta <- posts %>%
# mutate(sentence=gsub("[\n]{2,}", "。", sentence))
# 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
#reef_sentences <- strsplit(reef_meta$sentence,"[。！；？!?;]")
#將每句句子，與他所屬的文章連結配對起來，整理成一個dataframe
#reef_sentences <- data.frame(
# artUrl = rep(reef_meta$artUrl, sapply(reef_sentences, length)),
# sentence = unlist(reef_sentences)
# ) %>%
# filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
# 如果有\t或\n就去掉
# reef_sentences$sentence <- as.character(reef_sentences$sentence)
# reef_sentences文章斷詞
#文章斷詞
#load reef_lexicon(特定要斷開的詞，像是user_dict)
#reef_lexicon <- scan(file = "./dict/reef_dict.txt", what=character(),sep='\n',
# encoding='utf-8',fileEncoding='utf-8')
# load stop words
# stop_words <- scan(file = "./dict/stop_words.txt", what=character(),sep='\n',
# encoding='utf-8',fileEncoding='utf-8')
# 使用默認參數初始化一個斷詞引擎
#jieba_tokenizer = worker()
# 使用口罩字典重新斷詞
#new_user_word(jieba_tokenizer, c(reef_lexicon))
# tokenize function
#chi_tokenizer <- function(t) {
# lapply(t, function(x) {
# if(nchar(x)>1){
# tokens <- segment(x, jieba_tokenizer)
# tokens <- tokens[!tokens %in% stop_words]
# 去掉字串長度爲1的詞彙
# tokens <- tokens[nchar(tokens)>1]
# return(tokens)
# }
# })
# }
# 用剛剛初始化的斷詞器把sentence斷開
# tokens <- reef_sentences %>%
# mutate(sentence = gsub("[[:punct:]]", "",sentence)) %>%
# mutate(sentence = gsub("[0-9a-zA-Z]", "",sentence)) %>%
# unnest_tokens(word, sentence, token=chi_tokenizer) %>%
# count(artUrl, word) %>% # 計算每篇文章出現的字頻
# rename(count=n)
# tokens
# save.image(file = "./data/token_result.rdata")斷詞結果可以先存起來，就不用再重跑一次
load("./data/token_result.rdata")清理斷詞結果
。根據詞頻，選擇只出現3字以上的字 。整理成url,word,n的格式之後，就可以轉dtm
P.S. groupby by之後原本的字詞結構會不見，把詞頻另存在一個reserved_word裡面
freq = 3
# 依據字頻挑字
reserved_word <- tokens %>%
group_by(word) %>%
count() %>%
filter(n > freq) %>%
unlist()
reef_removed <- tokens %>%
filter(word %in% reserved_word)
#reef_dtm 裡面 nrow:幾篇文章 ; ncol:幾個字
reef_dtm <- reef_removed %>% cast_dtm(artUrl, word, count) (2) LDA 主題分析
將剛處理好的dtm放入LDA函式分析
# LDA分成4個主題
reef_lda <- LDA(reef_dtm, k = 4, control = list(seed = 123))p.s. 。tidy(reef_lda, matrix = “beta”) # 取字 topic term beta值 。tidy(reef_lda, matrix=“gamma”) # 取主題 document topic gamma
取出代表字詞(term)
removed_word = c("不是","每天","出來","覺得","藻礁")
# 看各群的常用詞彙
tidy(reef_lda, matrix = "beta") %>% # 取出topic term beta值
filter(! term %in% removed_word) %>%
group_by(topic) %>%
top_n(10, beta) %>% # beta值前10的字
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 1 = “政院三接外推方案”
topic 2 = “府方試圖找環團溝通”
topic 3 = “海岸開發議題”
topic 4 = “藍綠政黨攻防與抹黑”
以下我們挑出第二個主題與第四個主題來做比較。
取出代表主題(topic)
每篇文章拿gamma值最大的topic當該文章的topic
# 在tidy function中使用參數"gamma"來取得 theta矩陣
reef_topics <- tidy(reef_lda, matrix="gamma") %>% # document topic gamma
group_by(document) %>%
top_n(1, wt=gamma)
reef_topics## # A tibble: 1,090 x 3
## # Groups: document [1,090]
## document topic gamma
## <chr> <int> <dbl>
## 1 https://www.ptt.cc/bbs/Gossiping/M.1610188174.A.1A3.html 1 0.335
## 2 https://www.ptt.cc/bbs/Gossiping/M.1613987110.A.267.html 1 0.727
## 3 https://www.ptt.cc/bbs/Gossiping/M.1614080959.A.C2C.html 1 0.620
## 4 https://www.ptt.cc/bbs/Gossiping/M.1614097481.A.6B3.html 1 0.778
## 5 https://www.ptt.cc/bbs/Gossiping/M.1614142421.A.6D4.html 1 0.998
## 6 https://www.ptt.cc/bbs/Gossiping/M.1614170691.A.60D.html 1 0.435
## 7 https://www.ptt.cc/bbs/Gossiping/M.1614216623.A.E12.html 1 0.756
## 8 https://www.ptt.cc/bbs/Gossiping/M.1614217554.A.4AD.html 1 0.530
## 9 https://www.ptt.cc/bbs/Gossiping/M.1614217800.A.28C.html 1 0.997
## 10 https://www.ptt.cc/bbs/Gossiping/M.1614218643.A.4E0.html 1 0.622
## # ... with 1,080 more rows資料內容探索
posts_topic <- merge(x = posts, y = reef_topics, by.x = "artUrl", by.y="document")
# 看一下各主題在說甚麼
set.seed(123)
posts_topic %>% # 主題二
filter(topic==1) %>%
select(artTitle) %>%
unique() %>%
sample_n(5)## artTitle
## 1 Re:[新聞]蔡英文回應藻礁公投：期許大家理解政治現
## 2 [黑特]幹你娘還我原本的三接
## 3 [討論]國民黨2024當選，三接要蓋哪？
## 4 [問卦]不是有乾淨的煤?現在幹嘛破壞藻礁??
## 5 Re:[新聞]公投大戰執政黨力拚萊豬、藻礁解危posts_topic %>% # 主題四
filter(topic==2) %>%
select(artTitle) %>%
unique() %>%
sample_n(5)## artTitle
## 1 [新聞]宣稱不缺電藻礁永存何需毀諾
## 2 [新聞]蔡英文回應藻礁公投：期許大家理解政治現
## 3 [新聞]詹順貴挺三接外推環團分裂
## 4 [新聞]「擁核派也有環保意識」潘忠政：沒理由
## 5 [新聞]藻礁公投連署告急…在野聲援日期主題分布
posts_topic %>%
group_by(artCat,topic) %>%
summarise(sum = n()) %>%
ggplot(aes(x= artCat,y=sum,fill=as.factor(topic))) +
geom_col(position="dodge") 
> 從上圖可以看到藻礁公投主題分布
其中，主題四在八卦版及政黑版佔的比例皆為最高，我們推測是因為PTT的鄉民比較喜歡去探討有關藍綠兩黨間的問題。
與我們上禮拜使用新聞網的資料及有所差異
4. 社群網路圖
資料合併
# 文章和留言
reviews <- reviews %>%
select(artUrl, cmtPoster, cmtStatus, cmtContent)
posts_Reviews <- merge(x = posts, y = reviews, by = "artUrl")
# 把文章和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.媒體來源:\n自由時報\n\n2.記者署名:\n吳書緯\n\n3.完整新聞標題:\n籲保護藻礁生態 陳椒華︰時力黨部將響應珍愛藻礁公投連署\n\n4.完整新聞內文:\n\n面對\n和\n，恐因能源轉型所進行的開發遭受破壞，民眾黨立\n委邱臣遠和時代力量黨主席、立委陳椒華今共同呼籲，政府應針對能源轉型政策說清楚目\n標，謙卑傾聽人民聲音；陳椒華更宣布，時力全台各地黨部將會響應「珍愛藻礁」公投連\n署，保護藻礁生態。\n\n環團今在立院舉行「公民的海洋公民 救藻礁公投 搶救外木山／大潭藻礁與基隆珊瑚聯合\n抗爭」記者會；珍愛藻礁公投領銜人潘忠政指出，這是搶救大潭藻礁第122次記者會，也\n是和基隆守護珊瑚團體合作的第一次記者會。\n\n陳椒華表示，桃園大潭電廠的天然氣第三接收站將破壞7000年歷史的藻礁和柴山多杯孔珊\n瑚，而基隆外木三的協和電廠第四接收站要填海造陸18.6公頃，將淹埋7萬多株珊瑚，也\n無視當地的保育類綠蠵龜和玳瑁龜。\n\n對此，陳椒華表示，為了擴張天然氣接收站，破壞豐富的自然資源和海洋生態，對於生態\n有強烈衝擊，能源轉型的目標不該只放在2025年，更應對2050年長遠規劃，不斷檢視大型\n發電廠發電成本和電網問題，並規畫有效的節電政策，讓再生能源成為發電主力，因此不\n一定需要在桃園觀塘設置三接以及基隆外木山填海造陸。\n\n基隆出身的邱臣遠表示，能源轉型與環境、海洋生態並不是二元對立，能源轉型需要不斷\n的與社會溝通，站在國家能源政策的立場，原則支持燃油改燃氣，但台電與經濟部應該更\n主動、謙卑溝通，並針對各界的疑慮說清楚。\n\n此外，邱臣遠也質疑，協和電廠按規畫要到2027年才會完全商轉，但能源轉型的政策，未\n來10、20年能源轉型的目標到底是什麼，以及天然氣發電未來的占比，台電和經濟部能源\n局在去年底立法院能遠轉型公聽會都沒有辦法具體回答。\n\n時代力量基隆市議員陳薇仲表示，\n陳薇仲感嘆，「民進黨政府對海洋議題是無聲回應嗎」，呼籲民進黨要正視能源轉型議題\n，採取各種方案來降低對生態的破壞，趕快做出檢討，否則「向海致敬」只會變空虛的口\n號。\n\n無黨籍基隆市議員王醒之說，無論是中油觀塘三接、協和火力發電廠四接、北方三島離岸\n風電的共同特色，就是「能源轉型之名，行環境不義之實」，能源轉型到頭來也是要回到\n跟生態環境之間做選擇的老路，這樣的轉型有正義可言嗎？過去半世紀來，台灣能源開發\n都是這個舊的邏輯，能源轉型必須要有新的思維，他也在提出協和電廠可設置永久浮動是\n馬頭（FSRU）作為填海造陸替代方案。\n\n海洋學者陳昭倫指出，桃園大潭藻礁和基隆外木山的珊瑚群聚，代表台灣西北海岸最為珍\n貴的兩個獨特、命運相連的生態系；外木山的珊瑚群聚在氣候變遷衝擊下也是生物重要的\n庇護所。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/politics/breakingnews/3403832\n6.備註:\n\n
## 2 1.媒體來源:\n自由時報\n\n2.記者署名:\n吳書緯\n\n3.完整新聞標題:\n籲保護藻礁生態 陳椒華︰時力黨部將響應珍愛藻礁公投連署\n\n4.完整新聞內文:\n\n面對\n和\n，恐因能源轉型所進行的開發遭受破壞，民眾黨立\n委邱臣遠和時代力量黨主席、立委陳椒華今共同呼籲，政府應針對能源轉型政策說清楚目\n標，謙卑傾聽人民聲音；陳椒華更宣布，時力全台各地黨部將會響應「珍愛藻礁」公投連\n署，保護藻礁生態。\n\n環團今在立院舉行「公民的海洋公民 救藻礁公投 搶救外木山／大潭藻礁與基隆珊瑚聯合\n抗爭」記者會；珍愛藻礁公投領銜人潘忠政指出，這是搶救大潭藻礁第122次記者會，也\n是和基隆守護珊瑚團體合作的第一次記者會。\n\n陳椒華表示，桃園大潭電廠的天然氣第三接收站將破壞7000年歷史的藻礁和柴山多杯孔珊\n瑚，而基隆外木三的協和電廠第四接收站要填海造陸18.6公頃，將淹埋7萬多株珊瑚，也\n無視當地的保育類綠蠵龜和玳瑁龜。\n\n對此，陳椒華表示，為了擴張天然氣接收站，破壞豐富的自然資源和海洋生態，對於生態\n有強烈衝擊，能源轉型的目標不該只放在2025年，更應對2050年長遠規劃，不斷檢視大型\n發電廠發電成本和電網問題，並規畫有效的節電政策，讓再生能源成為發電主力，因此不\n一定需要在桃園觀塘設置三接以及基隆外木山填海造陸。\n\n基隆出身的邱臣遠表示，能源轉型與環境、海洋生態並不是二元對立，能源轉型需要不斷\n的與社會溝通，站在國家能源政策的立場，原則支持燃油改燃氣，但台電與經濟部應該更\n主動、謙卑溝通，並針對各界的疑慮說清楚。\n\n此外，邱臣遠也質疑，協和電廠按規畫要到2027年才會完全商轉，但能源轉型的政策，未\n來10、20年能源轉型的目標到底是什麼，以及天然氣發電未來的占比，台電和經濟部能源\n局在去年底立法院能遠轉型公聽會都沒有辦法具體回答。\n\n時代力量基隆市議員陳薇仲表示，\n陳薇仲感嘆，「民進黨政府對海洋議題是無聲回應嗎」，呼籲民進黨要正視能源轉型議題\n，採取各種方案來降低對生態的破壞，趕快做出檢討，否則「向海致敬」只會變空虛的口\n號。\n\n無黨籍基隆市議員王醒之說，無論是中油觀塘三接、協和火力發電廠四接、北方三島離岸\n風電的共同特色，就是「能源轉型之名，行環境不義之實」，能源轉型到頭來也是要回到\n跟生態環境之間做選擇的老路，這樣的轉型有正義可言嗎？過去半世紀來，台灣能源開發\n都是這個舊的邏輯，能源轉型必須要有新的思維，他也在提出協和電廠可設置永久浮動是\n馬頭（FSRU）作為填海造陸替代方案。\n\n海洋學者陳昭倫指出，桃園大潭藻礁和基隆外木山的珊瑚群聚，代表台灣西北海岸最為珍\n貴的兩個獨特、命運相連的生態系；外木山的珊瑚群聚在氣候變遷衝擊下也是生物重要的\n庇護所。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/politics/breakingnews/3403832\n6.備註:\n\n
## 3 1.媒體來源:\n自由時報\n\n2.記者署名:\n吳書緯\n\n3.完整新聞標題:\n籲保護藻礁生態 陳椒華︰時力黨部將響應珍愛藻礁公投連署\n\n4.完整新聞內文:\n\n面對\n和\n，恐因能源轉型所進行的開發遭受破壞，民眾黨立\n委邱臣遠和時代力量黨主席、立委陳椒華今共同呼籲，政府應針對能源轉型政策說清楚目\n標，謙卑傾聽人民聲音；陳椒華更宣布，時力全台各地黨部將會響應「珍愛藻礁」公投連\n署，保護藻礁生態。\n\n環團今在立院舉行「公民的海洋公民 救藻礁公投 搶救外木山／大潭藻礁與基隆珊瑚聯合\n抗爭」記者會；珍愛藻礁公投領銜人潘忠政指出，這是搶救大潭藻礁第122次記者會，也\n是和基隆守護珊瑚團體合作的第一次記者會。\n\n陳椒華表示，桃園大潭電廠的天然氣第三接收站將破壞7000年歷史的藻礁和柴山多杯孔珊\n瑚，而基隆外木三的協和電廠第四接收站要填海造陸18.6公頃，將淹埋7萬多株珊瑚，也\n無視當地的保育類綠蠵龜和玳瑁龜。\n\n對此，陳椒華表示，為了擴張天然氣接收站，破壞豐富的自然資源和海洋生態，對於生態\n有強烈衝擊，能源轉型的目標不該只放在2025年，更應對2050年長遠規劃，不斷檢視大型\n發電廠發電成本和電網問題，並規畫有效的節電政策，讓再生能源成為發電主力，因此不\n一定需要在桃園觀塘設置三接以及基隆外木山填海造陸。\n\n基隆出身的邱臣遠表示，能源轉型與環境、海洋生態並不是二元對立，能源轉型需要不斷\n的與社會溝通，站在國家能源政策的立場，原則支持燃油改燃氣，但台電與經濟部應該更\n主動、謙卑溝通，並針對各界的疑慮說清楚。\n\n此外，邱臣遠也質疑，協和電廠按規畫要到2027年才會完全商轉，但能源轉型的政策，未\n來10、20年能源轉型的目標到底是什麼，以及天然氣發電未來的占比，台電和經濟部能源\n局在去年底立法院能遠轉型公聽會都沒有辦法具體回答。\n\n時代力量基隆市議員陳薇仲表示，\n陳薇仲感嘆，「民進黨政府對海洋議題是無聲回應嗎」，呼籲民進黨要正視能源轉型議題\n，採取各種方案來降低對生態的破壞，趕快做出檢討，否則「向海致敬」只會變空虛的口\n號。\n\n無黨籍基隆市議員王醒之說，無論是中油觀塘三接、協和火力發電廠四接、北方三島離岸\n風電的共同特色，就是「能源轉型之名，行環境不義之實」，能源轉型到頭來也是要回到\n跟生態環境之間做選擇的老路，這樣的轉型有正義可言嗎？過去半世紀來，台灣能源開發\n都是這個舊的邏輯，能源轉型必須要有新的思維，他也在提出協和電廠可設置永久浮動是\n馬頭（FSRU）作為填海造陸替代方案。\n\n海洋學者陳昭倫指出，桃園大潭藻礁和基隆外木山的珊瑚群聚，代表台灣西北海岸最為珍\n貴的兩個獨特、命運相連的生態系；外木山的珊瑚群聚在氣候變遷衝擊下也是生物重要的\n庇護所。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/politics/breakingnews/3403832\n6.備註:\n\n
## cmtPoster cmtStatus cmtContent topic gamma
## 1 popy8789 推 :4%實力不夠不要大小聲 1 0.3351678
## 2 yoyodiy → :唱過夢醒時分就以為自己很強？管到海邊去喔 1 0.3351678
## 3 eecoolty → :時力反核反媒反天然氣他們到底要啥來發電？ 1 0.3351678取出 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 580a679 DN-- 8883 54276 --
## + attr: name (v/c), artUrl (e/c)
## + edges from 580a679 (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資料篩選
資料篩選的方式：
- 文章:文章日期、留言數(commentNum)
- link、node:degree
# 看一下留言數大概都多少(方便後面篩選)
posts %>%
# filter(commentNum<100) %>%
ggplot(aes(x=commentNum)) + geom_histogram()
依據發文數或回覆數篩選post和review
# # 帳號發文篇數
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_select <- post_count %>% filter(count >= 2)
posts <- posts %>% filter(posts$artPoster %in% poster_select$artPoster)
# 回覆者
reviewer_select <- review_count %>% filter(count >= 20)
reviews <- reviews %>% filter(reviews$cmtPoster %in% reviewer_select$cmtPoster)# 檢視參與人數
length(unique(posts_Reviews$artPoster)) # 發文者數量 1143## [1] 533length(unique(posts_Reviews$cmtPoster)) # 回覆者數量 14856## [1] 8693allPoster <- c(posts_Reviews$artPoster, posts_Reviews$cmtPoster) # 總參與人數 15375
length(unique(allPoster))## [1] 8883標記所有出現過得使用者
- poster：只發過文、發過文+留過言
- replyer：只留過言
userList <- data.frame(user=unique(allPoster)) %>%
mutate(type=ifelse(user%in%posts$artPoster, "poster", "replyer"))
head(userList,3)## user type
## 1 ueewen replyer
## 2 qazsedcft poster
## 3 HsuGun poster以日期篩選社群
在228連假時連署呼聲的新聞報導數量增加，我們挑出當天的文章和回覆看看
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 25) %>%
filter(artCat=="Gossiping") %>%
filter(artDate == as.Date('2021-02-28')) %>%
select(cmtPoster, artPoster, artUrl) %>%
unique()
link## # A tibble: 59 x 3
## # Groups: cmtPoster, artUrl [59]
## cmtPoster artPoster artUrl
## <chr> <chr> <chr>
## 1 offstage xxxtakoxxx https://www.ptt.cc/bbs/Gossiping/M.1614473267.A.E5E.h~
## 2 devidevi gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082.A.3FB.h~
## 3 JT0624 gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082.A.3FB.h~
## 4 laroserose gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082.A.3FB.h~
## 5 PPPGGG gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082.A.3FB.h~
## 6 jack7614614 gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082.A.3FB.h~
## 7 Kidmo gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082.A.3FB.h~
## 8 gn01693664 roex0608 https://www.ptt.cc/bbs/Gossiping/M.1614482397.A.76D.h~
## 9 devidevi roex0608 https://www.ptt.cc/bbs/Gossiping/M.1614482397.A.76D.h~
## 10 STi2011 roex0608 https://www.ptt.cc/bbs/Gossiping/M.1614482397.A.76D.h~
## # ... with 49 more rows篩選在link裡面有出現的使用者
filtered_user <- userList %>%
filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
arrange(desc(type))
head(filtered_user,3)## user type
## 1 ueewen replyer
## 2 alan0204 replyer
## 3 xxxtakoxxx replyer這邊要篩選link中有出現的使用者，如果用沒篩過的userList（igraph中graph_from_data_frame的v參數吃的那個東西），圖上就會出現沒有在link裡面的nodes，圖片就會變得沒有意義
因爲圖片箭頭有點礙眼，所以這裏我們先把關係的方向性拿掉，減少圖片中的不必要的資訊
set.seed(487)
#set.seed 因為igraph呈現的方向是隨機的
v=filtered_user
reviewNetwork = degree(reviewNetwork) > 2
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:red
- replyer:green
set.seed(487)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster","gold","lightblue")
plot(reviewNetwork, vertex.size=3, edge.arrow.size=0.3,vertex.label=NA)
可以稍微看出圖中的點(人)之間有一定的關聯，不過目前只有單純圖形我們無法分析其中的內容。
因此以下我們將資料集中的資訊加到我們的圖片中。
為點加上帳號名字，用degree篩選要顯示出的使用者，以免圖形被密密麻麻的文字覆蓋
filter_degree = 5
set.seed(123)
# 設定 node 的 label/ color
labels <- degree(reviewNetwork) # 算出每個點的degree
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold","lightblue")
plot(
reviewNetwork,
vertex.size=3,
edge.width=3,
vertex.label.dist=1,
vertex.label=ifelse(degree(reviewNetwork) > filter_degree, V(reviewNetwork)$label, NA),vertex.label.font=2)
我們可以看到基本的使用者關係，但是我們希望能夠將更進階的資訊視覺化。
例如：使用者經常參與的文章種類，或是使用者在該社群網路中是否受到歡迎。
以主題篩選社群
- 抓link
挑選出2021-02-28當天的文章， 篩選一篇文章回覆3次以上者，且文章留言數多餘200則， 文章主題歸類為2(公投與府方環團溝通)與3(海岸開發議題)者， 欄位只取：cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 25) %>%
filter(artCat=="Gossiping") %>% #HatePolitics / Gossiping
filter(artDate == as.Date('2021-02-28')) %>%
filter(topic == 2 | topic == 3) %>%
select(cmtPoster, artPoster, artUrl, topic) %>%
unique()
link## # A tibble: 36 x 4
## # Groups: cmtPoster, artUrl [36]
## cmtPoster artPoster artUrl topic
## <chr> <chr> <chr> <int>
## 1 devidevi gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082~ 2
## 2 JT0624 gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082~ 2
## 3 laroserose gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082~ 2
## 4 PPPGGG gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082~ 2
## 5 jack7614614 gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082~ 2
## 6 Kidmo gginin007 https://www.ptt.cc/bbs/Gossiping/M.1614481082~ 2
## 7 devidevi Lampaininder https://www.ptt.cc/bbs/Gossiping/M.1614484353~ 2
## 8 r13974682 Lampaininder https://www.ptt.cc/bbs/Gossiping/M.1614484353~ 2
## 9 ssisters Lampaininder https://www.ptt.cc/bbs/Gossiping/M.1614484353~ 2
## 10 cfetan Lampaininder https://www.ptt.cc/bbs/Gossiping/M.1614484353~ 2
## # ... with 26 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 alan0204 replyer
## 2 gginin007 replyer
## 3 plzza0cats replyer使用者經常參與的文章種類
filter_degree = 5
# 建立網路關係
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 == "2", "palevioletred", "lightgreen")
# 畫出社群網路圖(degree>5的才畫出來)
set.seed(5432)
plot(reviewNetwork, vertex.size=3, 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("gold","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("公投與府方環團溝通","海岸開發議題"),
col=c("palevioletred", "lightgreen"), lty=1, cex=1)
使用者是否受到歡迎
PTT的回覆有三種，推文、噓文、箭頭，我們只要看推噓就好，因此把箭頭清掉，這樣資料筆數較少，所以我們把篩選的條件放寬一些。
filter_degree = 9 # 使用者degree
# 過濾留言者對發文者的推噓程度
link <- posts_Reviews %>%
filter(artCat=="Gossiping") %>%
filter(commentNum > 100) %>%
filter(cmtStatus!="→") %>%
group_by(cmtPoster, artUrl) %>%
filter( n() > 2) %>%
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(5432)
plot(reviewNetwork, vertex.size=2, 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("gold","lightblue"), pt.cex=1, cex=1)
legend("topleft", c("推","噓"),
col=c("lightgreen","palevioletred"), lty=1, cex=1)
可以發現本次的討論中幾乎都是推文、噓文較少
補充：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)
# 整理資料格式
nodes_complete <- data.frame(nodeID = unique(c(links$cmtPoster, links$artPoster)))
nodes_complete$group <- nodes$type[match(nodes_complete$nodeID, nodes$user)]
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.總結
- 大潭藻礁的討論重點有哪些? 主要分為哪幾種風向? 在228連假時連署呼聲的新聞報導數量增加，導致大家開始注意到此議題，談論的重點有公投聯署、府方環團溝通，海岸開發議題，藍綠兩黨間的批判。
- 5/3行政院提三接外推方案，在PTT中並沒有引發另一波話題高峰
目前風向最偏哪邊? 客觀討論的文章不少，但藍綠兩黨間的批判文章居多。
討論大潭藻礁的社群網路如何分布? 以社群文章數來看，批評嘲諷的網友較多，但從社群網路觀察發現，撇除政黨因素，大家以討論公投及環團溝通方面的議題為主。
大潭藻礁的意見領袖有誰?網友的推噓狀態如何? 在八卦版上，以公投及府方環團溝通議題為主的意見領袖有 akuan413，回覆推噓皆有。 調侃批評部分則有 NTUisgood，網友大多正面推文。 也有用幽默詼諧的方式來討論此議題如linhsiuwei