探討PTT八卦板對於京元電子群聚染疫及停工的看法
第18組 劉宜銘、卓怡姍、劉純妤、徐梓竣
2021/6/15
Ch0. 套件取得及資料載入
套件
Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼## [1] ""packages = c("readr", "dplyr", "jiebaR", "tidyr", "tidytext", "igraph", "topicmodels", "ggplot2", "stringr","udpipe","text2vec","LDAvis","servr","networkD3")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)library(data.table)
library(ggplot2)
library(dplyr)
library(jiebaR)
library(tidytext)
library(stringr)
library(tm)
library(topicmodels)
library(purrr)
require(RColorBrewer)
library(janeaustenr)
require(sentence)
library(reshape2)
library(wordcloud2)
library(igraph)
library(tidyr)
library(readr)
library(udpipe)
library(jsonlite)動機與分析目的
京元電子竹南廠爆發移工群聚感染武漢肺炎事件，截至目前為止確診數達300多人以上，該公司原採取不停工、人員調度的方式因應，但在各界批評聲浪下急改口停工，從6月4日晚班(7點20分)開始停工，一直到星期天(6月6日)晚班(7點20分)恢復上班，整整48個小時的時間。然而發生如此嚴重染疫事件僅短暫停工，令人難以理解。若是其他產業發生類似事件，是否能比照辦理呢? 因此本組想了解網友們對於該公司作法是否可以接受。
對於『苗栗京元電子廠』的群聚染疫事件，討論ptt版上相關討論的發文風向，主要針對以下方向分析：
1.京元電子的討論重點有哪些? 主要分為哪幾種風向? 2.討論京元電子的社群網路如何分布? 3.討論的意見領袖有誰?網友的推噓狀態如何?
資料描述
- 文字平台收集PTT八卦板 2021/06/1到2021/06/13
- 關鍵字：京元、京元電、京元電子
- 分為文章以及回覆
new_reviews <- read_csv("group_18_京元電子_4.csv")new_reviews %>%
mutate(artDate = as.Date(artDate)) %>%
group_by(artDate) %>%
summarise(count = n())%>%
ggplot(aes(artDate,count))+
geom_line(color="RoyalBlue", size = 1.5)+
# 2021-06-04 紅線
geom_vline(xintercept = as.numeric(as.Date("2021-06-04")), col='red', size = 1) +
ggtitle("討論文章數") +
xlab("日期") +
ylab("數量") +
geom_point()
顯見6/4為討論度的最高峰值
議題時間表
06月02日 出現京元電子群聚爆至39人的新聞訊息 06月03日 京元電子快篩7300員工 06月03日 京元電子內部信曝光！晚班員工繼續上班。針對停工部份，李金恭表示，「茲事體大，國際動線很高，(停工)會影響國內外的生產規劃跟管理」，所以暫不停工。 06月04日 京元電子員工群聚事件擴大，有77人確診 06月04日 經濟部長王美花上午親自打電話京元電子董事長李金恭，要求全力配合中央流行疫情指揮中心與地方防疫主管機關，下午緊急宣布停工2天進行全面消毒 06月04日 中央疫情指揮中心下午1時進駐京元電子竹南廠 06月04日 京元電子77人PCR確診，公布新足跡縣府認了疫調慢 06月05日 苗栗的IC封測廠超豐爆發9名移工染疫 06月06日 京元電子公司要求準時復工，但外籍移工全面停工 06月07日 討論京元電子為何復工
Ch1. LDA 主題分類
(1)資料前處理
# # 文章斷句("\n\n"取代成"。")
mask_meta <- new_reviews %>%
mutate(sentence=gsub("[\n]{2,}", "。", new_reviews$artContent))
# 查前後字
# na.omit(str_extract(mask_meta, ".*世界.*"))
# 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
mask_sentences <- strsplit(mask_meta$sentence,"[。！；？!?;]")
# 將每句句子，與他所屬的文章連結配對起來，整理成一個dataframe
mask_sentences <- data.frame(
artUrl = rep(mask_meta$artUrl, sapply(mask_sentences, length)),
sentence = unlist(mask_sentences)
) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
# 如果有\t或\n就去掉
mask_sentences$sentence <- as.character(mask_sentences$sentence)
# mask_sentences文章斷詞
# load mask_lexicon(特定要斷開的詞，像是user_dict)
mask_lexicon <- scan(file = "mask_lexicon.txt", what=character(),sep='\n',
encoding='utf-8',fileEncoding='utf-8')
# load stop words
stop_words <- scan(file = "stop_words.txt", what=character(),sep='\n',
encoding='utf-8',fileEncoding='utf-8')
# 使用默認參數初始化一個斷詞引擎
jieba_tokenizer = worker()
# 使用字典重新斷詞
new_user_word(jieba_tokenizer, c(mask_lexicon))## [1] TRUE# 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 <- mask_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)
save.image(file = "token_result.rdata")文字雲
tokens %>% count(word,sort=TRUE) %>% filter(!(word == "京元")) %>% filter(n > 10) %>% wordcloud2()初步來看，八卦版網友對於京元染疫事件描述包括「確診」、「停工」、「疫情」、「外勞」。
清理斷詞結果
根據詞頻，選擇只出現3字以上的字 整理成url,word,n的格式之後，就可以轉dtm
load("token_result.rdata")
freq = 3
# 依據字頻挑字
reserved_word <- tokens %>%
group_by(word) %>%
count() %>%
filter(n > freq) %>%
unlist()
mask_removed <- tokens %>%
filter(word %in% reserved_word)
#mask_dtm 裡面 nrow:幾篇文章 ; ncol:幾個字
mask_dtm <- mask_removed %>% cast_dtm(artUrl, word, count) (2)LDA 主題分析
LDA分成3個主題
mask_lda <- LDA(mask_dtm, k = 3, control = list(seed = 123))取出代表字詞(term)
removed_word = c("可能","如題","萬劑","台灣","京元","不是","完整","記者")
# 看各群的常用詞彙
tidy(mask_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)
# 每篇文章拿gamma值最大的topic當該文章的topic
# 在tidy function中使用參數"gamma"來取得 theta矩陣
mask_topics <- tidy(mask_lda, matrix="gamma") %>% # document topic gamma
group_by(document) %>%
top_n(1, wt=gamma)
mask_topics## # A tibble: 448 x 3
## # Groups: document [448]
## document topic gamma
## <chr> <int> <dbl>
## 1 https://www.ptt.cc/bbs/Gossiping/M.1622542911.A.635.html 1 0.982
## 2 https://www.ptt.cc/bbs/Gossiping/M.1622642883.A.D3C.html 1 0.542
## 3 https://www.ptt.cc/bbs/Gossiping/M.1622647511.A.9F5.html 1 0.359
## 4 https://www.ptt.cc/bbs/Gossiping/M.1622648929.A.47C.html 1 0.550
## 5 https://www.ptt.cc/bbs/Gossiping/M.1622687359.A.FEA.html 1 0.573
## 6 https://www.ptt.cc/bbs/Gossiping/M.1622722162.A.F82.html 1 0.810
## 7 https://www.ptt.cc/bbs/Gossiping/M.1622740669.A.148.html 1 0.781
## 8 https://www.ptt.cc/bbs/Gossiping/M.1622772999.A.B3A.html 1 0.983
## 9 https://www.ptt.cc/bbs/Gossiping/M.1622773656.A.492.html 1 0.988
## 10 https://www.ptt.cc/bbs/Gossiping/M.1622774357.A.51B.html 1 0.499
## # ... with 438 more rows資料內容探索
# topics_name = c("疫苗議題討論","京元外勞與停工","苗栗群聚感染")
posts_topic <- merge(x = new_reviews, y = mask_topics, by.x = "artUrl", by.y="document")
# 看一下各主題在說甚麼
# 主題一:疫苗議題討論
set.seed(123)
posts_topic %>%
filter(topic==1) %>%
select(artTitle) %>%
unique() %>%
sample_n(20)## artTitle
## 1 Re:[問卦]都沒有人覺得疫苗接種分級有錯嗎？
## 2 Re:[新聞]快訊／台積電竹科廠1員工確診 遭京元電
## 3 [問卦]竹科>>其他地方？？
## 4 Re:[新聞]郭台銘買BNT缺原廠授權?陳時中:怕買到假
## 5 Re:[爆卦]醫師公會聲明-北市府一直沒按照中央安
## 6 Re:[新聞]好心肝違法打疫苗指揮中心深夜撂重話！
## 7 [新聞]討好企業？傳台南市府擬將公司幹部納疫苗
## 8 [問卦]現在是不是該先封存京元復工會議記錄
## 9 Re:[問卦]好奇為啥京元電子開工了？
## 10 Re:[新聞]京元電子爆45確診…再篩出51陽性！董事長
## 11 [新聞]日本參議員：5月下旬台灣方面正式請求提
## 12 Re:[問卦]京元電假如再爆鍋責任算誰的？
## 13 Re:[新聞]日本參議員：5月下旬台灣方面正式請求提
## 14 [問卦]補助80萬移工全部打高端當三期?
## 15 [問卦]是否要紿京元電上班員工打疫苗?
## 16 [問卦]是偷打疫苗嚴重還是只跟日本求100萬嚴重
## 17 Re:[新聞]快訊／京元電77人PCR確診 公布新足跡縣
## 18 Re:[新聞]朱學恒抓到了！日本議員證實訊息指台灣只
## 19 Re:[問卦]京元電不停工放任染疫真的沒問題嗎?
## 20 Re:[新聞]不只京元電指揮中心證實超豐9名移工也染# 主題二：京元外勞與停工
posts_topic %>%
filter(topic==2) %>%
select(artTitle) %>%
unique() %>%
sample_n(20)## artTitle
## 1 [問卦]這一波京元電公司影響多大的八卦？
## 2 Re:[問卦]以前罵AZ現在打AZ心態？
## 3 Re:[問卦]動到電子業才趕快開始緊急授權?
## 4 [問卦]京元近7000人快篩陽性1%，不幸中大幸嗎？
## 5 [問卦]不覺得桃園很危險嗎?
## 6 Re:[問卦]請問一下京元電薪資好嗎？想應徵
## 7 [問卦]京元電假如再爆鍋責任算誰的？
## 8 Re:[新聞]苗栗電子廠群聚疫情擴大累計140人確診
## 9 Re:[問卦]中部是不是危險了
## 10 Re:[新聞]京元電快篩51人陽性仍急叩員工進產線
## 11 [問卦]我照常亂跑照常出去玩布拉德特羅爾
## 12 [問卦]病毒的顏色？
## 13 Re:[新聞]台塑員工返鄉發病 高雄市府連夜載104名
## 14 Re:[新聞]遭批購買疫苗不力 蘇貞昌：你買不到雞腿
## 15 [問卦]我們離四級的距離有多遠
## 16 [問卦]勒令停業是不是很有選擇性？！
## 17 Re:[新聞]蔡英文：「愛家鄉的人，就留在原地」
## 18 [問卦]京元電子每年都賺錢說明什麼?
## 19 [問卦]其實需要的是停工或停班標準吧?
## 20 [問卦]最近出現一堆努力上班的人染疫??# 主題三:苗栗群聚感染
posts_topic %>%
filter(topic==3) %>%
select(artTitle) %>%
unique() %>%
sample_n(20)## artTitle
## 1 [新聞]京元電晚班起將停工2天7廠全面清消
## 2 Re:[問卦]京元電子每年都賺錢說明什麼?
## 3 [新聞]京元群聚風暴快篩「30陰轉陽」改全廠
## 4 [新聞]苗栗驚爆第二家電子廠女員工確診返回雲林
## 5 [問卦]京元電的確診數是算在哪一天
## 6 [新聞]京元電子移工傳送南榮科大舊址黃偉哲:篩
## 7 [新聞]苗栗移工下班禁足令陳宗彥：在隔離中本就不得外
## 8 [問卦]CO2有因為不桃事件被罰300萬了？
## 9 Re:[新聞]苗栗＋34本土！徐耀昌一圖解決京元電39
## 10 [新聞]苗栗電子廠增16確診力積電也淪陷
## 11 [新聞]苗栗疫情｜京元電不停工！員工淚控遭逼上
## 12 Re:[新聞]苗栗今日0確診只是暫時！京元電二次快篩
## 13 [新聞]京元電染疫風暴電子業：政府應有效管理
## 14 [問卦]中央社請進
## 15 Re:[爆卦]總統四點半發表談話
## 16 [新聞]京元、超豐141人確診智邦科技也中鏢！
## 17 [新聞]京元電移工停班14天產線降載本國員工緊
## 18 Re:[問卦]京元電不停工放任染疫真的沒問題嗎?
## 19 Re:[爆卦]京元電子快篩
## 20 [問卦]指揮中心接管苗栗後今天+0從主題分布大概可以看到幾類觀點：
主題一：疫苗議題討論，疫情擴散與疫苗的不足，日本疫苗捐贈，如「都沒有人覺得疫苗接種分級有錯嗎？」、「疫苗全民免費！蔡英文：輪到你就去打」、「講台灣只需100萬劑疫苗就是佐籐」
主題二：京元外勞與停工，沒有人可以要求京元電子停工，京元電子僅願意外籍勞工停工，討論s內容包含，如「京元電快篩51人陽性仍急叩員工進產線」、「京元停工會發生什麼事？」、「美髮業看到京元電會想什麼？」
主題三:苗栗群聚感染，感染數量日益遽增，陽性率不斷提高，多數討論CDC進駐苗栗後的檢疫情況，例如「京元電子爆45確診…再篩出51陽性」、「京元、超豐141人確診，智邦科技也中鏢！」、「苗栗驚爆第二家電子廠女員工確診」、
日期主題分布
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")
發現隨著時間增加，主題一的比例逐漸減少，且主題二的比例大於主題三。
posts_topic %>%
group_by(artCatagory,topic) %>%
summarise(sum = n()) %>%
ggplot(aes(x= artCatagory,y=sum,fill=as.factor(topic))) +
geom_col(position="dodge")
討論京元外勞與停工議題未曾消減。
Ch3. Document Term Matrix
將資料轉換為Document Term Matrix (DTM)
removed_word <- c("京元","電子","昨天","指出","一定","根本")
tokens <- tokens%>%filter(! word %in% removed_word)
dtm <-tokens %>% cast_dtm(artUrl, word, count)
# inspect(dtm[1:10,1:10])建立DTM matrix
dtf <- document_term_frequencies(tokens, document = "artUrl", term = "word")
dtm <- document_term_matrix(x = dtf)
dtm_clean <- dtm_remove_lowfreq(dtm, minfreq = 30)
# dim(dtm_clean)
set.seed(2019)
topic_n = 3
lda_model =text2vec::LDA$new(n_topics = topic_n,doc_topic_prior = 0.1, topic_word_prior = 0.001)
doc_topic_distr =lda_model$fit_transform(dtm_clean, n_iter = 1000, convergence_tol = 1e-5,check_convergence_every_n = 100)## INFO [17:18:40.613] early stopping at 50 iteration
## INFO [17:18:40.880] early stopping at 30 iteration### LDAvis
lda_model$get_top_words(n = 10, lambda = 0.5) # 查看 前10主題字## [,1] [,2] [,3]
## [1,] "公司" "不要" "連結"
## [2,] "累計" "上班" "媒體"
## [3,] "居家" "老闆" "記者"
## [4,] "防疫" "病毒" "來源"
## [5,] "接觸" "台灣" "完整"
## [6,] "疫情" "問題" "網址"
## [7,] "工作" "不會" "署名"
## [8,] "分流" "政府" "內文"
## [9,] "台灣" "停工" "備註"
## [10,] "狀況" "一下" "新聞標題"#lda_model$plot(out.dir ="lda_result", open.browser = TRUE)
knitr::include_graphics("T1.jpg")
knitr::include_graphics("T2.jpg")
knitr::include_graphics("T3.jpg")
本次設定三個主題數，可以發現topic1出現的頻率最高，達到50.3%。可以發現，“苗栗群聚”，“移工確診”，“竹南疫情”等有效字眼出現頻率較高。topic2多為“停工上班分流”，“公司政府”等關心議題。topic3則主要與“防疫”、“疫苗”占較大比例。
Ch4. 社群網路圖
資料合併
ptt_comment = do.call(rbind, lapply(1:nrow(new_reviews), function(i) {
# transfer string to dataframe
if(validate(new_reviews$artComment[i])){
comment_ = fromJSON(new_reviews$artComment[i])
# check number of comment
if(length(comment_) == 0){
NULL
}else{
# add artPoster form source-data
comment_$source = new_reviews$artPoster[i]
comment_$artUrl = new_reviews$artUrl[i]
comment_
}
}
}))
# 文章和留言
ptt_comment <- ptt_comment %>%
select(artUrl, cmtPoster, cmtStatus, cmtContent)
# 資料合併
posts_Reviews <- merge(x = new_reviews, y = ptt_comment, by = "artUrl")
# 把文章和topic
posts_Reviews <- merge(x = posts_Reviews, y = mask_topics, by.x = "artUrl", by.y="document")
#取出 cmtPoster(回覆者)、artPoster(發文者)、artUrl(文章連結) 三個欄位
link <- posts_Reviews %>% select(cmtPoster, artPoster, artUrl)
head(link,3)## cmtPoster artPoster artUrl
## 1 yycbr eddy12357 https://www.ptt.cc/bbs/Gossiping/M.1622542911.A.635.html
## 2 Wugautaigo eddy12357 https://www.ptt.cc/bbs/Gossiping/M.1622542911.A.635.html
## 3 dragon0 eddy12357 https://www.ptt.cc/bbs/Gossiping/M.1622542911.A.635.html基本網路圖
reviewNetwork <- graph_from_data_frame(d=link, directed=T)
reviewNetwork## IGRAPH aeaca0c DN-- 6161 16364 --
## + attr: name (v/c), artUrl (e/c)
## + edges from aeaca0c (vertex names):
## [1] yycbr ->eddy12357 Wugautaigo ->eddy12357 dragon0 ->eddy12357
## [4] netio ->eddy12357 sunsam ->eddy12357 ajemtw ->eddy12357
## [7] gov200269 ->eddy12357 samgreco ->eddy12357 Leika ->eddy12357
## [10] cck525 ->eddy12357 GAOTT ->eddy12357 wawaking1 ->eddy12357
## [13] md3q6e ->eddy12357 md3q6e ->eddy12357 vshchen ->eddy12357
## [16] vshchen ->eddy12357 catatonic ->eddy12357 LULU5566 ->eddy12357
## [19] LULU5566 ->eddy12357 johnko64665->eddy12357 johnko64665->eddy12357
## [22] azeroth ->eddy12357 Tenging ->eddy12357 tidworker ->eddy12357
## + ... omitted several edges畫出網路圖
# plot(reviewNetwork)
# plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,vertex.label=NA)
knitr::include_graphics("N2.png")
knitr::include_graphics("N1.png")
資料篩選
方式： + 文章:文章日期、留言數(commentNum) + link、node:degree
posts <- read_csv(".\\2excel\\京元電子_articleMetaData.csv")
reviews <- read_csv(".\\2excel\\_oldsys_articleReviews.csv")
# 資料合併
posts_topic <- merge(x = posts, y = mask_topics, by.x = "artUrl", by.y="document")
# 文章和留言
reviews <- reviews %>%
select(artUrl, cmtPoster, cmtStatus, cmtContent)
posts_Reviews <- merge(x = posts, y = reviews, by = "artUrl")
# 把文章和topic
posts_Reviews <- merge(x = posts_Reviews, y = mask_topics, by.x = "artUrl", by.y="document")
link <- posts_Reviews %>% select(cmtPoster, artPoster, artUrl)
head(link,3)## cmtPoster artPoster
## 1 QBey g45298
## 2 LoveMakeLove g45298
## 3 sherlockxx g45298
## artUrl
## 1 https://www.ptt.cc/bbs/Gossiping/M.1622623257.A.E62.html
## 2 https://www.ptt.cc/bbs/Gossiping/M.1622623257.A.E62.html
## 3 https://www.ptt.cc/bbs/Gossiping/M.1622623257.A.E62.htmllink <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 200) %>%
filter(artCat=="Gossiping") %>%
filter(artDate == as.Date('2021-06-04')) %>%
select(cmtPoster, artPoster, artUrl) %>%
unique()
link## # A tibble: 76 x 3
## # Groups: cmtPoster, artUrl [76]
## cmtPoster artPoster artUrl
## <chr> <chr> <chr>
## 1 jim924211 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 2 s9321312 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 3 alcard22 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 4 Vladivostok willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 5 newstyle willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 6 hubertmax willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 7 gunfighter willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 8 linkmusic willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 9 ejru65m4 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 10 smalltwo TWOOOOOOOOOO https://www.ptt.cc/bbs/Gossiping/M.1622772639.A.D80~
## # ... with 66 more rows# 看一下留言數大概都多少(方便後面篩選)
posts %>%
ggplot(aes(x=commentNum)) + geom_histogram()
可能事件發生不久，發現留言次數幾乎都是集中在50幾則左右。
依據發文數或回覆數篩選post和review
# # 帳號發文篇數
post_count = posts %>%
group_by(artPoster) %>%
summarise(count = n()) %>%
arrange(desc(count))
post_count## # A tibble: 117 x 2
## artPoster count
## <chr> <int>
## 1 tw689 5
## 2 Whitening 3
## 3 aliceric29 2
## 4 caelum 2
## 5 hk410050 2
## 6 KZsmith 2
## 7 polyhome 2
## 8 POWERSERIES 2
## 9 ppp123 2
## 10 stevenchiang 2
## # ... with 107 more rows# # 帳號回覆總數
review_count = reviews %>%
group_by(cmtPoster) %>%
summarise(count = n()) %>%
arrange(desc(count))
review_count## # A tibble: 6,384 x 2
## cmtPoster count
## <chr> <int>
## 1 lml99 102
## 2 zakijudelo 61
## 3 jim924211 54
## 4 KCKCLIN 53
## 5 luckyalbert 47
## 6 chung74511 46
## 7 dracula83183 45
## 8 WenliYang 44
## 9 DPP48 42
## 10 popy8789 39
## # ... with 6,374 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)) # 發文者數量 117## [1] 117length(unique(posts_Reviews$cmtPoster)) # 回覆者數量 6384## [1] 6384allPoster <- c(posts_Reviews$artPoster, posts_Reviews$cmtPoster) # 總參與人數 6454
length(unique(allPoster))## [1] 6454userList <- data.frame(user=unique(allPoster)) %>%
mutate(type=ifelse(user%in%posts$artPoster, "poster", "replyer"))
head(userList)## user type
## 1 g45298 replyer
## 2 Ctmate replyer
## 3 botnet replyer
## 4 e068401 replyer
## 5 am711206 replyer
## 6 jk199258 replyer標記所有出現過得使用者
以日期篩選社群
6月4日為討論最高峰，我們來看看文章與回覆內容
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 200) %>%
filter(artCat=="Gossiping") %>%
filter(artDate == as.Date('2021-06-04')) %>%
select(cmtPoster, artPoster, artUrl) %>%
unique()
link## # A tibble: 76 x 3
## # Groups: cmtPoster, artUrl [76]
## cmtPoster artPoster artUrl
## <chr> <chr> <chr>
## 1 jim924211 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 2 s9321312 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 3 alcard22 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 4 Vladivostok willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 5 newstyle willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 6 hubertmax willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 7 gunfighter willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 8 linkmusic willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 9 ejru65m4 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472.A.F2F~
## 10 smalltwo TWOOOOOOOOOO https://www.ptt.cc/bbs/Gossiping/M.1622772639.A.D80~
## # ... with 66 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 willieliu replyer
## 2 TWOOOOOOOOOO replyer
## 3 saiya replyerset.seed(487)
# v=filtered_user
reviewNetwork = degree(reviewNetwork) > 2
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=T)
plot(reviewNetwork, vertex.size=6, 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=6, 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=6,
edge.width=0.1,
vertex.label.dist=1,
vertex.label=ifelse(degree(reviewNetwork) > filter_degree, V(reviewNetwork)$label, NA),vertex.label.font=2)
以主題篩選社群
挑選出2021-06-04當天的文章， 篩選一篇文章回覆3次以上者，且文章留言數多餘200則， 文章主題明確，包含3類，1(疫苗議題討論)、2(京元外勞與停工)與3(京元群聚感染 )者， 欄位只取：cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)
# 抓link
link <- posts_Reviews %>%
group_by(cmtPoster, artUrl) %>%
filter(n()>3) %>%
filter(commentNum > 200) %>%
filter(artCat=="Gossiping") %>% #HatePolitics / Gossiping
filter(artDate == as.Date('2021-06-04')) %>%
select(cmtPoster, artPoster, artUrl, topic) %>%
unique()
link## # A tibble: 76 x 4
## # Groups: cmtPoster, artUrl [76]
## cmtPoster artPoster artUrl topic
## <chr> <chr> <chr> <int>
## 1 jim924211 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 2 s9321312 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 3 alcard22 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 4 Vladivostok willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 5 newstyle willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 6 hubertmax willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 7 gunfighter willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 8 linkmusic willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 9 ejru65m4 willieliu https://www.ptt.cc/bbs/Gossiping/M.1622769472~ 3
## 10 smalltwo TWOOOOOOOOOO https://www.ptt.cc/bbs/Gossiping/M.1622772639~ 3
## # ... with 66 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 willieliu replyer
## 2 TWOOOOOOOOOO replyer
## 3 saiya 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","blue"), 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
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") # 設定推噓顏色
)knitr::include_graphics("F1.jpg")
總結
1.京元電子的討論重點有哪些? 主要分為哪幾種風向? 討論重點分為：疫苗議題討論、京元外勞與停工、苗栗群聚感染 多數網友熱議京元電子為何不停工?為何可以再次復工?本籍員工淚控遭逼上班?其他產業沒事被停？
2.討論京元電子的社群網路如何分布? 以社群文章討論熱度來看，6/4發布停工兩日以及6/7本籍勞工恢復上班
3.討論的意見領袖有誰?網友的推噓狀態如何? 意見領袖不多，多數網友熱於回覆貼文。其中「tw689」發表討論停復工議題，包含“[問卦]指揮中心允許京元電復工，出事會負責嗎?”、“[爆卦]京元電今晚準時復工了！”，回覆者多數不認同此作法，紛紛表示“台勞的命不是命”、“努力工作戰勝病毒”、“笑死,確診這麼多人,政府不敢下令停工?”..等質疑聲浪及批判性語句 尤其「TWoooooooooo」回覆多篇貼文，表達強烈不滿，例如“有紓困了韭菜們賣靠夭”、“不要太不滿”、“阿英：台灣有台GG”..。