ptt理科太太文章討論網路關係

library(readr)
library(dplyr)
library(jiebaR)
library(tidyr)
library(tidytext)
library(igraph)
library(topicmodels)
library(stringr)
library(ggplot2)

# 讀取ptt理科太太討論資料
posts <- read_csv("./ptt_LiKeTaiTai.csv")

Parsed with column specification:
cols(
  artTitle = col_character(),
  artDate = col_date(format = ""),
  artTime = col_time(format = ""),
  artUrl = col_character(),
  artContent = col_character()
)

posts

# 讀取ptt理科太太討論串回覆資料
reviews <- read_csv("./articleMetaData.csv")

Parsed with column specification:
cols(
  artTitle = col_character(),
  artDate = col_date(format = ""),
  artTime = col_time(format = ""),
  artUrl = col_character(),
  artPoster = col_character(),
  artCat = col_character(),
  commentPoster = col_character(),
  commentStatus = col_character(),
  commentDate = col_datetime(format = ""),
  commentContent = col_character()
)

reviews

# 只選取需要的欄位
reviews <- reviews %>%
      select(artUrl, artPoster, commentPoster,commentStatus, commentContent)
reviews

# 發文者數量
length(unique(reviews$artPoster))

[1] 192

# 回覆者數量
length(unique(reviews$commentPoster))

[1] 5357

# 總共有參與的人數
allPoster <- c(reviews$artPoster, reviews$commentPoster)
length(unique(allPoster))

[1] 5478

建立社群網路圖

# 把評論和文章依據artUrl innerJoin起來
posts_Reviews <- merge(x = posts, y = reviews, by = "artUrl")
posts_Reviews

# 整理所有出現過的使用者
# 如果他曾發過文的話就標註他爲poster
# 如果沒有發過文的話則標註他爲replyer
userList <- data.frame(user=unique(allPoster)) %>%
              mutate(type=ifelse(user%in%posts_Reviews$artPoster, "poster", "replyer"))
userList

# 取出 commentPoster(回覆者)、artPoster(發文者)、artUrl(文章連結)、commentStatus(評論狀態)、artDate(日期)五個欄位
link <- posts_Reviews %>%
        select(commentPoster, artPoster, artUrl, commentStatus, artDate)
link

# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link, directed=T)
reviewNetwork

IGRAPH c2a3a48 DN-- 3369 5556 -- 
+ attr: name (v/c), artUrl (e/c), commentStatus (e/c), artDate (e/n)
+ edges from c2a3a48 (vertex names):
 [1] heat0204   ->moneybuy  heat0204   ->moneybuy  jimmyyyyyy ->moneybuy 
 [4] jerry83688 ->moneybuy  jerry83688 ->moneybuy  leon82guy  ->moneybuy 
 [7] vivi830505 ->waymayday clamperni  ->waymayday fangbr     ->waymayday
[10] mij        ->waymayday jajujo     ->waymayday Bokolo     ->waymayday
[13] fishouse   ->waymayday Jin63916   ->waymayday zxc8424    ->waymayday
[16] sclbtlove  ->waymayday s080014    ->waymayday fishouse   ->waymayday
[19] sclbtlove  ->waymayday Beanoodle  ->waymayday motop7689  ->waymayday
[22] motop7689  ->waymayday sclbtlove  ->waymayday g820215    ->charco   
+ ... omitted several edges

# 畫出網路圖
plot(reviewNetwork)

只看11/4的文章和它的回覆

# 篩選11/4的文章和它的回覆
# 取出 commentPoster(回覆者)、artPoster(發文者)、artUrl(文章連結)、commentStatus(評論狀態)、artDate(發文日期)五個欄位
# ptt的回覆有三種，推文、噓文、箭頭
# 我們只要看推噓就好，因此把箭頭清掉
link2 <- posts_Reviews %>%
  filter(artDate=='2018-11-4', commentStatus!="→") %>%
  select(commentPoster, artPoster, artUrl, commentStatus, artDate)
link2

# 這邊要篩選link中有出現的使用者
# 因爲如果userList（igraph中graph_from_data_frame的v參數吃的那個東西）中出現了沒有在link中出現的使用者
# 也會被igraph畫上去，圖片就會變得沒有意義
filtered_user <- userList %>%
          filter(user%in%link2$commentPoster | user%in%link2$artPoster) %>%
          arrange(desc(type))
filtered_user

# 建立網路關係
reviewNetwork2 <- graph_from_data_frame(d=link2, v=filtered_user, directed=T)
reviewNetwork2

IGRAPH 574bd98 DN-B 21 19 -- 
+ attr: name (v/c), type (v/c), artUrl (e/c), commentStatus (e/c), artDate (e/n)
+ edges from 574bd98 (vertex names):
 [1] vivi830505 ->waymayday clamperni  ->waymayday fangbr     ->waymayday
 [4] mij        ->waymayday jajujo     ->waymayday fishouse   ->waymayday
 [7] Jin63916   ->waymayday zxc8424    ->waymayday s080014    ->waymayday
[10] motop7689  ->waymayday tim9527    ->charco    chivalry70 ->charco   
[13] RLH        ->charco    zukidelko  ->charco    Sougetu    ->charco   
[16] kanetakusan->charco    nrxadsl    ->charco    osan       ->charco   
[19] kauosong   ->charco   

# 畫出網路圖
plot(reviewNetwork2)

針對node, edge 進行屬性標記

# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork2)
V(reviewNetwork2)$label <- names(labels)
V(reviewNetwork2)$color <- ifelse(V(reviewNetwork2)$type=="poster", "gold", "lightblue")
# 使用推噓文作爲連線的顏色
E(reviewNetwork2)$color <- ifelse(E(reviewNetwork2)$commentStatus == "推", "green", "red")

畫出社群網路圖

## 畫出社群網路圖
set.seed(217)
V(reviewNetwork2)$color <- ifelse(V(reviewNetwork2)$type=="poster", "gold", "lightblue")
plot(reviewNetwork2, vertex.size=15, edge.arrow.size=.5,
     vertex.label=ifelse(degree(reviewNetwork2) >2, V(reviewNetwork2)$label, NA),  vertex.label.ces=.8)
# 顯示中文內容
# set the font family to "serif", saving defaults in `op`
op <- par(family = "Heiti TC Light") # par函數用於設定或詢問繪圖參數

# 加入標示，於右下角顯示node color 說明
legend("bottomright", 
       title = "node color",
       c("poster","replyer"), pch=21, col="#777777",pt.bg=c("gold","lightblue"), pt.cex=1, cex=.8)
# 加入標示，於左上角顯示edge color 說明
legend("topleft", 
       title = "edge color",
       c("推","噓"), col=c("green","red"), lty=1, cex=.8, text.font = )

## reset plotting parameters
par(op)

結語：
使用network的視覺化可以讓我們了解11/4的文章 以charco、waymayday兩位發文者的評論為主，其中charco的發文都是推文 waymayday有3則噓文。 PTT是有名的反指標，當戰理科太太在八卦變成流行，那就代表理科太太成功了， 因為只有夠份量的公眾人物，才會引起PTT鄉民戰他的興趣。 透過這樣視覺化就能先了解初步的架構，進而對內容做細部的探討。