SMA Week 14: 社群網路分析反串之亂
讀書會第六組：鍾秉恩、徐湛、曾靖翔、林幸佳、黃子芹
2021/5/30
系統參數設定
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 Gossiping(八卦版)、PTT HatePolitics(政黑版)，蒐集事件相關文章與回覆
- 資料集： concernTroll_articleMetaData.csv、concernTroll_articleReviews.csv
- 關鍵字：認知作戰、林瑋豐、網軍、側翼
- 資料時間：2021-05-24 ~ 2021-05-28
針對5/24發生的反串之亂(寫手之亂)事件，討論ptt版上相關討論的發文風向，主要針對以下方向分析：
1.反串之亂的討論重點有哪些? 主要分為哪幾種風向? 2.目前風向最偏哪邊? 3.討論反串之亂的社群網路如何分布? 4.反串之亂的意見領袖有誰?網友的推噓狀態如何?
Part 1: 資料前處理
在本篇分析中，我們希望建構特定議題的社群網路圖，並分析網路中討論的議題主題
我們需要兩種資料： (1) 每篇文章的主題分類(LDA) (2) 社群網路圖的link和nodes
載入文章和網友回覆資料
posts <- read_csv("../data/concernTroll_articleMetaData.csv")
reviews <- read_csv("../data/concernTroll_articleReviews.csv")
head(posts)## # A tibble: 6 x 10
## artTitle artDate artTime artUrl artPoster artCat commentNum push boo
## <chr> <date> <time> <chr> <chr> <chr> <dbl> <dbl> <dbl>
## 1 [問卦]林瑋豐出~ 2021-05-24 11:01:00 https:/~ DrLisaSu Gossi~ 1181 793 55
## 2 [爆卦]找到原因~ 2021-05-24 11:50:40 https:/~ patrick5~ Gossi~ 1096 771 23
## 3 Re:[問卦]林~ 2021-05-24 11:52:51 https:/~ sunchen0~ Gossi~ 17 9 0
## 4 Re:[問卦]林~ 2021-05-24 11:54:42 https:/~ Goog1e Gossi~ 83 58 2
## 5 Re:[問卦]林~ 2021-05-24 12:01:06 https:/~ Hyuui Gossi~ 172 127 3
## 6 Re:[問卦]林~ 2021-05-24 12:05:55 https:/~ fywlp Gossi~ 16 7 0
## # ... with 1 more variable: sentence <chr>head(reviews)## # A tibble: 6 x 10
## artTitle artDate artTime artUrl artPoster artCat cmtPoster cmtStatus
## <chr> <date> <time> <chr> <chr> <chr> <chr> <chr>
## 1 [問卦]林瑋豐出來~ 2021-05-24 11:01 https://ww~ DrLisaSu Gossi~ leevarchu →
## 2 [問卦]林瑋豐出來~ 2021-05-24 11:01 https://ww~ DrLisaSu Gossi~ pcshgod 推
## 3 [問卦]林瑋豐出來~ 2021-05-24 11:01 https://ww~ DrLisaSu Gossi~ Goog1e 推
## 4 [問卦]林瑋豐出來~ 2021-05-24 11:01 https://ww~ DrLisaSu Gossi~ cucusow 推
## 5 [問卦]林瑋豐出來~ 2021-05-24 11:01 https://ww~ DrLisaSu Gossi~ nckuff →
## 6 [問卦]林瑋豐出來~ 2021-05-24 11:01 https://ww~ DrLisaSu Gossi~ beergap →
## # ... with 2 more variables: cmtDate <dttm>, cmtContent <chr>Part 2: LDA 主題分類
文章斷句
# # 文章斷句("\n\n"取代成"。")
# meta <- posts %>%
# mutate(sentence=gsub("[\n]{2,}", "。", sentence))
#
# # 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
# sentences <- strsplit(meta$sentence,"[。！；？!?;]")
#
# # 將每句句子，與他所屬的文章連結配對起來，整理成一個dataframe
# sentences <- data.frame(
# artUrl = rep(meta$artUrl, sapply(sentences, length)),
# sentence = unlist(sentences)
# ) %>%
# filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
# 如果有\t或\n就去掉
# sentences$sentence <- as.character(sentences$sentence)
# sentences文章斷詞
# ## 文章斷詞
# # load lexicon(特定要斷開的詞，像是user_dict)
# lexicon <- scan(file = "../dict/lexicon.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(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 <- 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/concernTroll_token.rdata")斷詞結果可以先存起來，就不用再重跑一次
load("../data/concernTroll_token.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()
removed <- tokens %>%
filter(word %in% reserved_word)
#dtm 裡面 nrow:幾篇文章 ; ncol:幾個字
dtm <- removed %>% cast_dtm(artUrl, word, count) LDA 主題分析
將剛處理好的dtm放入LDA函式分析
# LDA分成5個主題
lda <- LDA(dtm, k = 5, control = list(seed = 123))p.s. 。tidy(lda, matrix = “beta”) # 取字 topic term beta值 。tidy(lda, matrix=“gamma”) # 取主題 document topic gamma
取出代表字詞(term)
removed_word = c("不是","每天","出來","覺得","認知","作戰","有沒有","不會","可能","不要","一起","指出","是否","最近","看到")
# 看各群的常用詞彙
tidy(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 = “林瑋豐在ptt帶風向再到個人臉書寫文章”
topic 3 = “疫苗、相關報導”
topic 4 = “王定宇帶風向說中共在ptt發動認知作戰”
topic 5 = “林瑋豐老婆是民進黨設中心主任”
以下我們挑出第二個主題與第四個主題來做比較。
取出代表主題(topic)
每篇文章拿gamma值最大的topic當該文章的topic
# 在tidy function中使用參數"gamma"來取得 theta矩陣
topics <- tidy(lda, matrix="gamma") %>% # document topic gamma
group_by(document) %>%
top_n(1, wt=gamma)
topics## # A tibble: 664 x 3
## # Groups: document [664]
## document topic gamma
## <chr> <int> <dbl>
## 1 https://www.ptt.cc/bbs/Gossiping/M.1621440399.A.DB1.html 1 0.992
## 2 https://www.ptt.cc/bbs/Gossiping/M.1621441916.A.8B9.html 1 0.898
## 3 https://www.ptt.cc/bbs/Gossiping/M.1621443377.A.320.html 1 0.986
## 4 https://www.ptt.cc/bbs/Gossiping/M.1621450708.A.865.html 1 0.995
## 5 https://www.ptt.cc/bbs/Gossiping/M.1621476288.A.312.html 1 0.529
## 6 https://www.ptt.cc/bbs/Gossiping/M.1621481852.A.525.html 1 0.606
## 7 https://www.ptt.cc/bbs/Gossiping/M.1621489565.A.D42.html 1 0.987
## 8 https://www.ptt.cc/bbs/Gossiping/M.1621497285.A.E4B.html 1 0.461
## 9 https://www.ptt.cc/bbs/Gossiping/M.1621504003.A.F8E.html 1 0.948
## 10 https://www.ptt.cc/bbs/Gossiping/M.1621506227.A.544.html 1 0.705
## # ... with 654 more rows資料內容探索
posts_topic <- merge(x = posts, y = topics, by.x = "artUrl", by.y="document")
# 看一下各主題在說甚麼
set.seed(123)
posts_topic %>% # 主題二
filter(topic==2) %>%
select(artTitle) %>%
unique() %>%
sample_n(5)## artTitle
## 1 [新聞]寫手林瑋豐自導自演PTT助中國認知戰調查
## 2 [問卦]賀！林瑋豐先生不日將高升
## 3 [轉錄]名師出高徒范雲-林瑋豐師徒集團
## 4 Re:[爆卦]林瑋豐:自以為有趣的反串
## 5 [新聞]1450條款昨三讀政府不能偷養網軍posts_topic %>% # 主題四
filter(topic==4) %>%
select(artTitle) %>%
unique() %>%
sample_n(5)## artTitle
## 1 [轉錄]林瑋豐FB:一切只是好玩
## 2 [轉錄]林瑋豐：道歉及說明
## 3 [新聞]林瑋豐：沒有自導自演「疾管家帳號」事
## 4 [新聞]綠稱PTT助陸「認知作戰」真相曝光前藍委酸爆王定宇
## 5 [新聞]林瑋豐抹黑「衛福部疾管家」恐違法？指揮這次我們把討論焦點放在反串之亂的網友討論上，從主題分布大概可以看到兩類觀點：
- 主題二：
大部分是針對事件主角進行討論，如「寫手林瑋豐自導自演PTT助中國認知戰調查」、「賀！林瑋豐先生不日將高升」等。
- 主題四：
針對疾管家、事件相關人、政黨的討論，少部分討論眼球中央電視台，關鍵字有眼球、寫手、民進黨、王定宇等。
日期主題分布
畫出每天topic的分布，發現主題三的比例較大(代表大部分是議題相關報導)，主題二、四比例都較低，也能看出此事件雖然參雜政治，但網友大部分還是在八卦版上討論，政黑版的討論數相對較少。
posts_topic %>%
mutate(artDate = as.Date(artDate)) %>%
group_by(artDate,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.
Part 3: 社群網路圖
資料合併
# 文章和留言
reviews <- reviews %>%
select(artUrl, cmtPoster, cmtStatus, cmtContent)
posts_Reviews <- merge(x = posts, y = reviews, by = "artUrl")
# 把文章和topic
posts_Reviews <- merge(x = posts_Reviews, y = topics, by.x = "artUrl", by.y="document")
head(posts_Reviews,3)## artUrl
## 1 https://www.ptt.cc/bbs/Gossiping/M.1621440399.A.DB1.html
## 2 https://www.ptt.cc/bbs/Gossiping/M.1621440399.A.DB1.html
## 3 https://www.ptt.cc/bbs/Gossiping/M.1621440399.A.DB1.html
## artTitle artDate artTime artPoster artCat
## 1 [問卦]幹！為什麼4%網軍都抓不到 2021-05-19 16:06:36 kons Gossiping
## 2 [問卦]幹！為什麼4%網軍都抓不到 2021-05-19 16:06:36 kons Gossiping
## 3 [問卦]幹！為什麼4%網軍都抓不到 2021-05-19 16:06:36 kons Gossiping
## commentNum push boo
## 1 32 6 11
## 2 32 6 11
## 3 32 6 11
## sentence
## 1 之前站方抓了一堆綠共網軍，史稱3000英靈殿，\n\n這表示，只要站方想抓網軍，肯定抓的到的嘛！要不要抓的問題而已。\n\n現在版上只要是民進黨的新聞，蘇光頭出來講個話，英皇震怒一下的文章，\n\n全部都被4%網軍噓到爆，罵到翻！\n\n看看只是賭藍之類的粉專，跟這邊的風向完全不同，很明顯這裡已經被4%網軍控制了。\n\n柯韓粉網軍已經大舉入侵佔據ptt瘋狂帶風向，這麼顯而易見的事情，\n\n政府都已經說過了不缺電，就是一堆網軍在洗電力議題，其心可議！\n\n為什麼站方就是不抓4%網軍呢？\n\n是不是站方人員自己本身就是4%的人馬啊？\n\n出來解釋啊！！！有沒有八卦？？
## 2 之前站方抓了一堆綠共網軍，史稱3000英靈殿，\n\n這表示，只要站方想抓網軍，肯定抓的到的嘛！要不要抓的問題而已。\n\n現在版上只要是民進黨的新聞，蘇光頭出來講個話，英皇震怒一下的文章，\n\n全部都被4%網軍噓到爆，罵到翻！\n\n看看只是賭藍之類的粉專，跟這邊的風向完全不同，很明顯這裡已經被4%網軍控制了。\n\n柯韓粉網軍已經大舉入侵佔據ptt瘋狂帶風向，這麼顯而易見的事情，\n\n政府都已經說過了不缺電，就是一堆網軍在洗電力議題，其心可議！\n\n為什麼站方就是不抓4%網軍呢？\n\n是不是站方人員自己本身就是4%的人馬啊？\n\n出來解釋啊！！！有沒有八卦？？
## 3 之前站方抓了一堆綠共網軍，史稱3000英靈殿，\n\n這表示，只要站方想抓網軍，肯定抓的到的嘛！要不要抓的問題而已。\n\n現在版上只要是民進黨的新聞，蘇光頭出來講個話，英皇震怒一下的文章，\n\n全部都被4%網軍噓到爆，罵到翻！\n\n看看只是賭藍之類的粉專，跟這邊的風向完全不同，很明顯這裡已經被4%網軍控制了。\n\n柯韓粉網軍已經大舉入侵佔據ptt瘋狂帶風向，這麼顯而易見的事情，\n\n政府都已經說過了不缺電，就是一堆網軍在洗電力議題，其心可議！\n\n為什麼站方就是不抓4%網軍呢？\n\n是不是站方人員自己本身就是4%的人馬啊？\n\n出來解釋啊！！！有沒有八卦？？
## cmtPoster cmtStatus cmtContent
## 1 qweerrt123 噓 :現在策略變成噓政府就4%直接二分法？
## 2 kkiiccooo 噓 :柯糞吃屎
## 3 kuwanosan 推 :真的，我深綠居然也被罵4%，就因為我覺得這次陳時中做
## topic gamma
## 1 1 0.9924387
## 2 1 0.9924387
## 3 1 0.9924387取出 cmtPoster(回覆者)、artPoster(發文者)、artUrl(文章連結) 三個欄位
link <- posts_Reviews %>% select(cmtPoster, artPoster, artUrl)
head(link,3)## cmtPoster artPoster artUrl
## 1 qweerrt123 kons https://www.ptt.cc/bbs/Gossiping/M.1621440399.A.DB1.html
## 2 kkiiccooo kons https://www.ptt.cc/bbs/Gossiping/M.1621440399.A.DB1.html
## 3 kuwanosan kons https://www.ptt.cc/bbs/Gossiping/M.1621440399.A.DB1.html基本網路圖
建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, directed=T)
reviewNetwork## IGRAPH 022f21a DN-- 14478 70043 --
## + attr: name (v/c), artUrl (e/c)
## + edges from 022f21a (vertex names):
## [1] qweerrt123 ->kons kkiiccooo ->kons kuwanosan ->kons adsl15888 ->kons
## [5] twpisces ->kons OGC168 ->kons kuwanosan ->kons kkiiccooo ->kons
## [9] kuwanosan ->kons kuwanosan ->kons Submicromete->kons kuwanosan ->kons
## [13] cisyong ->kons cisyong ->kons jma306 ->kons zhmzhm ->kons
## [17] FuySenk ->kons freeclouds ->kons dnzteeqrq ->kons kuwanosan ->kons
## [21] gankgf ->kons sali921 ->kons pkpk23456 ->kons ayakiax ->kons
## [25] k47100014 ->kons a89182a89182->kons rjjq0305 ->kons firetim ->kons
## [29] firetim ->kons ltytw ->kons aja1008 ->kons BJC4100 ->kons
## + ... omitted several edges直接畫的話，因為點沒有經過篩選，看起來會密密麻麻的 還需要經過一次資料篩選，有興趣可以跑跑下面的code
# 畫出網路圖(密集恐懼警告)
# plot(reviewNetwork)
# plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,vertex.label=NA)資料篩選
資料篩選的方式：
- 文章:文章日期、留言數(commentNum)
- link、node:degree
# 看一下留言數大概都多少(方便後面篩選)
posts %>%
# filter(commentNum<100) %>%
ggplot(aes(x=commentNum)) + geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
依據發文數或回覆數篩選post和review
# # 帳號發文篇數
# post_count = posts %>%
# group_by(artPoster) %>%
# summarise(count = n()) %>%
# arrange(desc(count))
# post_count
#
# # 帳號回覆總數
# review_count = reviews %>%
# group_by(cmtPoster) %>%
# summarise(count = n()) %>%
# arrange(desc(count))
# review_count
# # 發文者
# 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)) # 發文者數量 503## [1] 503length(unique(posts_Reviews$cmtPoster)) # 回覆者數量 14291## [1] 14291allPoster <- c(posts_Reviews$artPoster, posts_Reviews$cmtPoster) # 總參與人數 14478
length(unique(allPoster))## [1] 14478標記所有出現過的使用者
- poster：只發過文、發過文+留過言
- replyer：只留過言
userList <- data.frame(user=unique(allPoster)) %>%
mutate(type=ifelse(user%in%posts$artPoster, "poster", "replyer"))
head(userList,3)## user type
## 1 kons poster
## 2 onetiger poster
## 3 l42857 poster以日期篩選社群
事件是5/24爆發的，我們挑出當天的文章和回覆看看
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 200) %>%
filter(artCat=="Gossiping") %>%
filter(artDate == as.Date('2021-05-24')) %>%
select(cmtPoster, artPoster, artUrl) %>%
unique()
link## # A tibble: 510 x 3
## # Groups: cmtPoster, artUrl [510]
## cmtPoster artPoster artUrl
## <chr> <chr> <chr>
## 1 TZUYIC Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 2 newmp4 Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 3 neoa01 Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 4 tupacshkur Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 5 jimmyso Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 6 phoenixhong Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 7 kroutony Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 8 mice2 Beatrice322 https://www.ptt.cc/bbs/Gossiping/M.1621822128.A.930.~
## 9 s9234032 borondawon https://www.ptt.cc/bbs/Gossiping/M.1621833645.A.E50.~
## 10 amida959 borondawon https://www.ptt.cc/bbs/Gossiping/M.1621833645.A.E50.~
## # ... with 500 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 jma306 replyer
## 2 FuySenk replyer
## 3 k47100014 replyer這邊要篩選link中有出現的使用者，如果用沒篩過的userList（igraph中graph_from_data_frame的v參數吃的那個東西），圖上就會出現沒有在link裡面的nodes，圖片就會變得沒有意義
p.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) > 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:gold(有發文)
- replyer:lightblue(只有回覆文章)
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 = 20
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-05-24當天的文章， 篩選一篇文章回覆3次以上者，且文章留言數多餘200則， 文章主題歸類為2(討論事件主角)與4(討論事件其他相關人物)者， 欄位只取：cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 200) %>%
filter(artCat=="Gossiping") %>% #HatePolitics / Gossiping
filter(artDate == as.Date('2021-05-24')) %>%
filter(topic == 2 | topic == 4) %>%
select(cmtPoster, artPoster, artUrl, topic) %>%
unique()
link## # A tibble: 311 x 4
## # Groups: cmtPoster, artUrl [311]
## cmtPoster artPoster artUrl topic
## <chr> <chr> <chr> <int>
## 1 jma306 uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 2 firemothra uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 3 spzoey uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 4 vow70 uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 5 Annis812 uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 6 yeng1217 uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 7 Rocksolid uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 8 YALEMY uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 9 talrasha uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## 10 swommy uhbygv45 https://www.ptt.cc/bbs/Gossiping/M.1621837522.A.3~ 4
## # ... with 301 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 jma306 replyer
## 2 FuySenk replyer
## 3 k47100014 replyer使用者經常參與的文章種類
filter_degree = 13
# 建立網路關係
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>7的才畫出來)
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 = 7 # 使用者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)
links = 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.總結
討論重點有哪些? 主要分為哪幾種風向? 對於2021-05-24 ~ 2021-05-28收集的文章，可以將討論重點分成政府操作網軍、林瑋豐在ptt以及個人臉書寫文章帶風向、與事件及疫苗的相關報導、王定宇貼文表示中共在ptt發動認知作戰、事件相關人物林瑋豐老婆是民進黨設中心主任等五個主題，討論重點多在於事實的正確與否、以及摻雜政治的討論。
目前風向最偏哪邊? 大多都是抨擊林瑋豐在疫情期間造謠，其他是討論是否林瑋豐有受政府或是眼球中央電視台指使帶風向。
討論此議題的社群網路如何分布? 以社群文章數來看，討論林瑋豐與其它事件相關人物的數量差不多，從社群網路觀察可以發現兩邊的貼文討論聲量都很高。
意見領袖有誰?網友的推噓狀態如何? 因為資料選取的時間較短，只要幾篇回覆量高的貼文，就有機會成為社群中心，雖然不少網友發的文章都引起許多回覆與討論，但根據觀察可知主要的意見領袖為socialism。