第十四周：社群網路分析

系統參數設定

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 Gossip版資料
關鍵字：停電、台電
資料時間：2021-05-11 ~ 2021-05-20

主要分析重點為：

對於5/13與5/17兩天停電的討論重點有哪些? 主要的風向如何?

目前風向最偏哪邊?

討論停電事件的社群網路如何分布?

停電事件的意見領袖有誰?

1. 資料前處理

在本篇分析中，我們希望建構特定議題的社群網路圖，並分析網路中討論的議題主題

我們需要兩種資料： (1) 每篇文章的主題分類(LDA) (2) 社群網路圖的link和nodes

載入文章和網友回覆資料

posts <- read_csv("../data/W15_articleMetaData.csv") #文章 1152

## Warning: 120 parsing failures.
##  row col   expected    actual                              file
## 1033  -- 10 columns 5 columns '../data/W15_articleMetaData.csv'
## 1034  -- 10 columns 5 columns '../data/W15_articleMetaData.csv'
## 1035  -- 10 columns 5 columns '../data/W15_articleMetaData.csv'
## 1036  -- 10 columns 5 columns '../data/W15_articleMetaData.csv'
## 1037  -- 10 columns 5 columns '../data/W15_articleMetaData.csv'
## .... ... .......... ......... .................................
## See problems(...) for more details.

reviews <- read_csv("../data/W15_articleReviews.csv") # 回覆 56501

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-10 16:23:46 https:~ crazylar~ Gossi~         13     3     1
## 2 Re:[問卦]台電~ 2021-05-10 16:47:45 https:~ ricky525  Gossi~          2     1     0
## 3 [問卦]上課上到一~ 2021-05-13 06:49:39 https:~ steven89~ Gossi~         10     6     2
## 4 [問卦]欸台中停電~ 2021-05-13 06:50:02 https:~ fyer      Gossi~         75    47     4
## 5 [問卦]台電這時候~ 2021-05-13 06:51:28 https:~ YellowC   Gossi~         24    14     1
## 6 [問卦]桃園停電了~ 2021-05-13 06:52:14 https:~ s4915562  Gossi~         63    32     1
## # ... 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-10 16:23:46 https://w~ crazylar~ Gossi~ wang1b    →        
## 2 [問卦]台電大樓停~ 2021-05-10 16:23:46 https://w~ crazylar~ Gossi~ spzper    →        
## 3 [問卦]台電大樓停~ 2021-05-10 16:23:46 https://w~ crazylar~ Gossi~ SilentBob →        
## 4 [問卦]台電大樓停~ 2021-05-10 16:23:46 https://w~ crazylar~ Gossi~ silent32~ →        
## 5 [問卦]台電大樓停~ 2021-05-10 16:23:46 https://w~ crazylar~ Gossi~ Johnnie5~ 推       
## 6 [問卦]台電大樓停~ 2021-05-10 16:23:46 https://w~ crazylar~ Gossi~ wmtsung   →        
## # ... with 2 more variables: cmtDate <dttm>, cmtContent <chr>

移除PTT貼新聞時會出現的格式用字

posts <- posts %>% 
  mutate(sentence=gsub("媒體來源|記者署名|完整新聞標題|完整新聞內文|完整新聞連結|(或短網址)|備註|備註請放最後面|違者新聞文章刪除", "", sentence))

reviews <- reviews %>% 
  mutate(cmtContent=gsub("媒體來源|記者署名|完整新聞標題|完整新聞內文|完整新聞連結|(或短網址)|備註|備註請放最後面|違者新聞文章刪除", "", cmtContent))

2.LDA 主題分類

文章斷句

## 文章斷句("\n\n"取代成"。")
#ele_meta <- posts %>%
#mutate(sentence=gsub("[\n]{2,}", "。", #sentence))

# 以全形或半形 驚歎號、問號、分號 以及 #全形句號 爲依據進行斷句
#ele_sentences <- #strsplit(ele_meta$sentence,"[。！；？!?;]")

# 將每句句子，與他所屬的文章連結配對起來，整理成一個dataframe
#ele_sentences <- data.frame(
#                        artUrl = #rep(ele_meta$artUrl, sapply(ele_sentences, #length)),
#                         sentence = #unlist(ele_sentences)
#                       ) %>%
#                       #filter(!str_detect(sentence, #regex("^(\t|\n| )*$")))
#                       # 如果有\t或\n就去掉
 
#ele_sentences$sentence <- #as.character(ele_sentences$sentence)
#ele_sentences

文章斷詞

## 文章斷詞
# load mask_lexicon(特定要斷開的詞，像是user_dict)
#ele_lexicon <- scan(file = #"../dict/mask_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(ele_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 <- ele_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()

ele_removed <- tokens %>% 
  filter(word %in% reserved_word)

#mask_dtm 裡面 nrow:幾篇文章 ; ncol:幾個字
ele_dtm <- ele_removed %>% cast_dtm(artUrl, word, count)

(2) LDA 主題分析

將剛處理好的dtm放入LDA函式分析

# LDA分成4個主題
ele_lda <- LDA(ele_dtm, k = 4, control = list(seed = 123))

p.s. 。tidy(mask_lda, matrix = “beta”) # 取字 topic term beta值。tidy(mask_lda, matrix=“gamma”) # 取主題 document topic gamma

取出代表字詞(term)

removed_word = c("不是","每天","出來","覺得","不會","不能") 

# 看各群的常用詞彙
tidy(ele_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矩陣
ele_topics <- tidy(ele_lda, matrix="gamma") %>% # document topic gamma
                  group_by(document) %>%
                  top_n(1, wt=gamma)
ele_topics

## # A tibble: 1,032 x 3
## # Groups:   document [1,032]
##    document                                                 topic gamma
##    <chr>                                                    <int> <dbl>
##  1 https://www.ptt.cc/bbs/Gossiping/M.1620888690.A.68F.html     1 0.660
##  2 https://www.ptt.cc/bbs/Gossiping/M.1620888736.A.E94.html     1 0.544
##  3 https://www.ptt.cc/bbs/Gossiping/M.1620888930.A.022.html     1 0.829
##  4 https://www.ptt.cc/bbs/Gossiping/M.1620889521.A.235.html     1 0.991
##  5 https://www.ptt.cc/bbs/Gossiping/M.1620889862.A.D64.html     1 0.976
##  6 https://www.ptt.cc/bbs/Gossiping/M.1620890378.A.EA1.html     1 0.678
##  7 https://www.ptt.cc/bbs/Gossiping/M.1620890591.A.09C.html     1 0.679
##  8 https://www.ptt.cc/bbs/Gossiping/M.1620890967.A.E44.html     1 0.993
##  9 https://www.ptt.cc/bbs/Gossiping/M.1620891192.A.CD3.html     1 0.972
## 10 https://www.ptt.cc/bbs/Gossiping/M.1620891275.A.A7D.html     1 0.716
## # ... with 1,022 more rows

資料內容探索

posts_topic <- merge(x = posts, y = ele_topics, by.x = "artUrl", by.y="document")

# 看一下各主題在說甚麼
set.seed(123)
posts_topic %>% # 主題一
  filter(topic==1) %>%
  select(artTitle) %>%
  unique() %>%
  sample_n(10)

##                                          artTitle
## 1      [新聞]5天內2次大停電朱立倫問蔡總統：你說台
## 2                      [問卦]台電員工是不是很衰小
## 3   Re:[新聞]兩次停電都有人為因素蔡英文：重新思考
## 4                    [問卦]可以不要再吵停電了嗎？
## 5  Re:[新聞]517大停電後神隱近22小時王美花錄影片向
## 6         Re:[問卦]台電跟台鐵是不是要民營化比較好
## 7     Re:[新聞]大停電「恐因缺水、非缺電」學者：瞬
## 8                [問卦]台電這次要抓誰出來背鍋？？
## 9              [問卦]住在火力發電場附近還停電是？
## 10  Re:[新聞]一周2度大停電台電退休高層：513只是開

set.seed(123)
posts_topic %>% # 主題二
  filter(topic==2) %>%
  select(artTitle) %>%
  unique() %>%
  sample_n(10)

##                                                         artTitle
## 1                                          [爆卦]513停電最全解析
## 2                    [新聞]用電吃緊！今恐又停電　將從「E組」開始
## 3                               [問卦]停電是不是太陽下山的錯!!??
## 4                                   [問卦]今天有核電還會停電嗎？
## 5                                        Re:[爆卦]推論停電的真相
## 6  [新聞]快訊／無預警大停電！　行政院證實：興達電廠12:45通報故障
## 7                     [新聞]C、D分區停電蘇貞昌：造成不便深表歉意
## 8                           [問卦]台電今年年終是不是會再創新高阿
## 9                    [新聞]電不夠用！台電盼民間共同節電啟動3措施
## 10                    Re:[問卦]台電的10%備用運轉量是參考用的嗎？

posts_topic %>% # 主題三
  filter(topic==3) %>%
  select(artTitle) %>%
  unique() %>%
  sample_n(10)

##                                        artTitle
## 1                [問卦]不停電區的房價會升高嗎？
## 2              [問卦]吹頭髮吹到一半停電有多慘？
## 3        [FB]有沒有綠色和平趁這次大停電造謠的八
## 4       Re:[問卦]這次全台大停電的戰犯應該是誰？
## 5  [問卦]現在A到F都會暫停電，台北高級豪宅也會嗎
## 6       [問卦]停電組別以當年度來區分真的有很好?
## 7            [問卦]C組跟D組4ㄅ4台電認證的賤民？
## 8                  [問卦]停電在女同事家能幹嘛？
## 9                              [問卦]有停電嗎？
## 10                       [問卦]有沒有停電的公式

posts_topic %>% # 主題四
  filter(topic==4) %>%
  select(artTitle) %>%
  unique() %>%
  sample_n(10)

##                                      artTitle
## 1                              [問卦]停電通知
## 2   [新聞]興達電廠跳機大停電陳其邁：最快晚間9
## 3     Re:[問卦]大家還記得20170815全台大停電嗎
## 4  [新聞]國中會考若停電影響照明將延長考試時間
## 5            [問卦]這次停電證明南電北送了吧？
## 6                  [問卦]志祺77家裡停電了嗎？
## 7  [新聞]全台大停電經濟部：晚上八點恢復全面供
## 8          [爆卦]LIVE又緊急停電台電臨時記者會
## 9  [新聞]停電夜高雄八五大樓「平安」燈仍續亮民
## 10     [問卦]全台大停電是不是因為人民鬆懈了？

各主題細目:

主題一 : > 大多是對政府的究責，如「5天內2次大停電朱立倫問蔡總統…」、「兩次停電都有人為因素蔡英文」、「517大停電後神隱近22小時王…」
主題二 : > 主要是對這次的停電事件做討論，如「513停電最全解析」、「推論停電的真相」、「台電的10%備用運轉量是參考用的嗎？」
主題三 : > 主要是人民對停電事件的感想，如「吹頭髮吹到一半停電有多慘？」、「停電在女同事家能幹嘛？」、「不停電區的房價會升高嗎？」
主題四： > 大多是針對停電的延伸探討，「國中會考若停電影響照明將延長考試時間」、「這次停電證明南電北送了吧？」、「大家還記得20170815全台…」

日期主題分布

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.

時間分布圖 : 5/11為有網友在討論版上問台電大樓是否停電了，與5/13的大停電事件無關。5/12因無停電事件所以無資料。主題一「對政府究責」在5/19達到高峰，民眾風向偏向究責政府，主題二「停電的原因」除5/16外都有討論，主題三「人民對停電的感想」則是最多人討論的部分，主題四「停電相關探討」在5/15及5/16皆沒有討論。
各主題數量長條圖 : 主題三 > 主題一 > 主題二 > 主題四

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 = ele_topics, by.x = "artUrl", by.y="document")
head(posts_Reviews,3)

##                                                     artUrl
## 1 https://www.ptt.cc/bbs/Gossiping/M.1620663828.A.D21.html
## 2 https://www.ptt.cc/bbs/Gossiping/M.1620663828.A.D21.html
## 3 https://www.ptt.cc/bbs/Gossiping/M.1620663828.A.D21.html
##                 artTitle    artDate  artTime  artPoster    artCat commentNum
## 1 [問卦]台電大樓停電了嗎 2021-05-10 16:23:46 crazylarry Gossiping         13
## 2 [問卦]台電大樓停電了嗎 2021-05-10 16:23:46 crazylarry Gossiping         13
## 3 [問卦]台電大樓停電了嗎 2021-05-10 16:23:46 crazylarry Gossiping         13
##   push boo
## 1    3   1
## 2    3   1
## 3    3   1
##                                                                             sentence
## 1 本以為內湖一片黑漆漆，結果沒想到台電大樓這邊也是化外之地？\n請問有人也停電了嗎？\n
## 2 本以為內湖一片黑漆漆，結果沒想到台電大樓這邊也是化外之地？\n請問有人也停電了嗎？\n
## 3 本以為內湖一片黑漆漆，結果沒想到台電大樓這邊也是化外之地？\n請問有人也停電了嗎？\n
##   cmtPoster cmtStatus          cmtContent topic     gamma
## 1    wang1b         →             :沒有愛     3 0.7905021
## 2    spzper         → :台電又調皮在藏電了     3 0.7905021
## 3 SilentBob         → :藏電藏到自己也沒電     3 0.7905021

取出 cmtPoster(回覆者)、artPoster(發文者)、artUrl(文章連結) 三個欄位

link <- posts_Reviews %>% select(cmtPoster, artPoster, artUrl)
head(link,3)

##   cmtPoster  artPoster                                                   artUrl
## 1    wang1b crazylarry https://www.ptt.cc/bbs/Gossiping/M.1620663828.A.D21.html
## 2    spzper crazylarry https://www.ptt.cc/bbs/Gossiping/M.1620663828.A.D21.html
## 3 SilentBob crazylarry https://www.ptt.cc/bbs/Gossiping/M.1620663828.A.D21.html

基本網路圖

建立網路關係

reviewNetwork <- graph_from_data_frame(d=link, directed=T)
reviewNetwork

## IGRAPH 35aefd7 DN-- 15192 56501 -- 
## + attr: name (v/c), artUrl (e/c)
## + edges from 35aefd7 (vertex names):
##  [1] wang1b      ->crazylarry   spzper      ->crazylarry  
##  [3] SilentBob   ->crazylarry   silent328kn ->crazylarry  
##  [5] Johnnie5334 ->crazylarry   wmtsung     ->crazylarry  
##  [7] wmtsung     ->crazylarry   NCTUEE800808->crazylarry  
##  [9] laechan     ->crazylarry   crazylarry  ->crazylarry  
## [11] ted01234567 ->crazylarry   Forcast     ->crazylarry  
## [13] zephyr105   ->crazylarry   janyuyu     ->ricky525    
## [15] janyuyu     ->ricky525     clw8        ->steven890722
## + ... 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

## # A tibble: 966 x 2
##    artPoster  count
##    <chr>      <int>
##  1 tw689          7
##  2 ccyaztfe       6
##  3 xampp          6
##  4 gmooshan       5
##  5 Induction      5
##  6 kimo6414       5
##  7 jiern          4
##  8 longyin        4
##  9 w510048        4
## 10 addison123     3
## # ... with 956 more rows

 # 帳號回覆總數
 review_count = reviews %>%
   group_by(cmtPoster) %>%
   summarise(count = n()) %>%
   arrange(desc(count)) 
 review_count

## # A tibble: 14,794 x 2
##    cmtPoster  count
##    <chr>      <int>
##  1 birdy590     246
##  2 cfetan       223
##  3 trywish      183
##  4 Anvec        164
##  5 gundam01     158
##  6 leon1757tw   137
##  7 ssisters     116
##  8 andy199113   112
##  9 leecliff     107
## 10 ppptttqaz     92
## # ... with 14,784 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) #回覆者超過20人
 reviews <- reviews %>%  filter(reviews$cmtPoster %in% reviewer_select$cmtPoster)

# 檢視參與人數
length(unique(posts_Reviews$artPoster)) # 發文者數量 841

## [1] 841

length(unique(posts_Reviews$cmtPoster)) # 回覆者數量 14794

## [1] 14794

allPoster <- c(posts_Reviews$artPoster, posts_Reviews$cmtPoster) # 總參與人數 15192
length(unique(allPoster))

## [1] 15192

標記所有出現過的使用者

poster：只發過文、發過文+留過言
replyer：只留過言

userList <- data.frame(user=unique(allPoster)) %>%
              mutate(type=ifelse(user%in%posts$artPoster, "poster", "replyer"))
head(userList,3)

##           user    type
## 1   crazylarry replyer
## 2     ricky525 replyer
## 3 steven890722 replyer

以日期篩選社群

第二次停電為5/17，距離第一次停電只有四天，而此次停電也引起多數人的不滿，我們挑出當天的文章和回覆看看大家的反應

link <- posts_Reviews %>%
      group_by(cmtPoster, artUrl) %>% 
      filter(n()>3) %>% 
      filter(commentNum > 10) %>% #大部分留言數介於大概10-30
      filter(artDate == as.Date('2021-05-17')) %>%
      select(cmtPoster, artPoster, artUrl) %>% 
      unique()
link

## # A tibble: 176 x 3
## # Groups:   cmtPoster, artUrl [176]
##    cmtPoster  artPoster artUrl                                                  
##    <chr>      <chr>     <chr>                                                   
##  1 s705166    HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  2 b19880115  HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  3 leon1757tw HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  4 kevinpc    HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  5 hawaii987  HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  6 andy199113 HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  7 rodes      HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  8 Annis812   HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
##  9 FFFFFFFF   HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
## 10 mow1982    HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.CF7.html
## # ... with 166 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 aa1477888 replyer
## 2  FFFFFFFF replyer
## 3  dearevan 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 = 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-05-17當天的文章，篩選一篇文章回覆3次以上者，且文章留言數多於5則，欄位只取：cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)

link <- posts_Reviews %>%
      group_by(cmtPoster, artUrl) %>% 
      filter(n()>3) %>% 
      filter(commentNum > 5) %>%
      filter(artCat=="Gossiping") %>% #HatePolitics / Gossiping
      filter(artDate == as.Date('2021-05-17')) %>%
      #filter(topic == 1| topic == 3) %>% 
      select(cmtPoster, artPoster, artUrl, topic) %>% 
      unique()
link

## # A tibble: 176 x 4
## # Groups:   cmtPoster, artUrl [176]
##    cmtPoster  artPoster artUrl                                             topic
##    <chr>      <chr>     <chr>                                              <int>
##  1 s705166    HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  2 b19880115  HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  3 leon1757tw HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  4 kevinpc    HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  5 hawaii987  HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  6 andy199113 HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  7 rodes      HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  8 Annis812   HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
##  9 FFFFFFFF   HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
## 10 mow1982    HisVol    https://www.ptt.cc/bbs/Gossiping/M.1621230604.A.C~     2
## # ... with 166 more rows

抓nodes 在所有的使用者裡面，篩選link中有出現的使用者

filtered_user <- userList %>%
          filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
          arrange(desc(type))
head(filtered_user,5)

##         user    type
## 1  aa1477888 replyer
## 2   FFFFFFFF replyer
## 3   dearevan replyer
## 4 aa123bb456 replyer
## 5    usokami 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, "orange", "lightgreen")

# 畫出社群網路圖(degree>7的才畫出來)
set.seed(5432)
plot(reviewNetwork, vertex.size=3, edge.width=3, edge.color = E(reviewNetwork)$topic , 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("人民對停電的感想(3)","停電的原因(2)", "對政府究責(1)", "停電相關探討(4)"), 
       col=c("skyblue","goldenrod2","seagreen","yellow"), lty=1, cex=1)

使用者是否受到歡迎

PTT的回覆有三種，推文、噓文、箭頭，我們只要看推噓就好，因此把箭頭清掉，這樣資料筆數較少，所以我們把篩選的條件放寬一些。

filter_degree = 5 # 使用者degree

# 過濾留言者對發文者的推噓程度
link <- posts_Reviews %>%
      filter(artCat=="Gossiping") %>% 
      filter(commentNum > 10) %>%
      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.

總結

對於5/13與5/17兩天停電的討論重點有哪些? 主要的風向如何?

關於此次停電事件的討論，共可分為四個討論風向，最多的兩種是對停電發表感想並對政府究責，另外還有對停電事件抽絲剝繭的分析和對停電的延伸討論，如南電北送的問題、國中會考遇到停電該怎麼處理…等。

目前風向最偏哪邊?

依據討論度最高的主題三，主題當中有幾篇為「不停電區的房價會升高嗎？」、「現在A到F都會暫停電，台北高級豪宅也會嗎」、「有沒有綠色和平趁這次大停電造謠的八」、「C組跟D組4ㄅ4台電認證的賤民？」，大家比較關心的多是停電會不會停到我家

討論停電事件的社群網路如何分布?
依據分布圖，回覆的狀況多以推文居多，而且有意見領袖貼文中的討論被分為不同主題討論的狀況。
停電事件的意見領袖有誰?
以網絡圖來看， mcrobert文章為新聞的轉貼討論，回文狀況正負都有。hk410050，文章也是新聞的轉貼，回文的狀況正負平均。xx60824xx，為轉貼新聞的文章，網友意見負面居多，用字遣詞較為激烈。

第十四周：社群網路分析

第8組-糠維軒張惠茹陳靖婷鄭宇謙張揚琛鄭周祥

2021/05/28

資料基本介紹

1. 資料前處理

移除PTT貼新聞時會出現的格式用字

2.LDA 主題分類

清理斷詞結果

(2) LDA 主題分析

取出代表字詞(term)

取出代表主題(topic)

資料內容探索

日期主題分布

4. 社群網路圖

基本網路圖

資料篩選

以日期篩選社群

加上nodes的顯示資訊

以主題篩選社群

使用者經常參與的文章種類

使用者是否受到歡迎

補充：networkD3

總結

第十四周：社群網路分析

第8組-糠維軒 張惠茹 陳靖婷 鄭宇謙 張揚琛 鄭周祥

2021/05/28

資料基本介紹

1. 資料前處理

移除PTT貼新聞時會出現的格式用字

2.LDA 主題分類

清理斷詞結果

(2) LDA 主題分析

取出代表字詞(term)

取出代表主題(topic)

資料內容探索

日期主題分布

4. 社群網路圖

基本網路圖

資料篩選

以日期篩選社群

加上nodes的顯示資訊

以主題篩選社群

使用者經常參與的文章種類

使用者是否受到歡迎

補充：networkD3

總結

第8組-糠維軒張惠茹陳靖婷鄭宇謙張揚琛鄭周祥