資料說明
資料來源：臉書
獲取方式：網絡爬蟲
資料蒐集時間：2019年01月01日至2020年01月31日
有效資料（N）=1,684
壹.動機與分析目的
Facebook是web2.0時代的重要社群網路代表之一，社群網路打破時間、空間的限制，讓資訊可以隨時傳達至各地的網路使用者，也因此網路社群開始成為政治領袖向民眾傳遞資訊的主要工具。而網路社群在政治選戰具有焦點的是在2015年的英國脫歐議題以及2016年美國總統大選。兩次被選戰經常被用於討論社群網路對政治選舉的重要影響。
在台灣2018年的市長選舉，韓國瑜出乎以往意料的在深綠的南台灣獲得大勝，部分也被認為網路社群影響了該次的選戰。因此，2020總統大選對於網路社群的影響亦是大家的焦點。故此將針對蔡英文、韓國瑜、宋楚瑜三位總統候選人在108年1月1日至109年1月11日facebook粉絲團的貼文進行分析，並洞悉三位候選人在facebook的使用以及候選人所採取的策略。
貳.資料分析
一、參數設定、載入資料與安裝包
gc()
rm(list=ls())
p<-read.csv("~/Desktop/四下/社群媒體/期中專案/Presidential candidate.csv")
setwd("~/Desktop/四下/社群媒體/期中專案")
pacman::p_load(prettydoc,dplyr,tidyr,jiebaR,jiebaRD,tidytext,RColorBrewer,wordcloud,ggplot2,lubridate,stringr,d3heatmap,igraph,ggraph,data.table,reshape2,scales,readr,reshape2,Rmisc)二、資料預處理
p$Page_Name<-gsub("蔡英文 Tsai Ing-wen", "蔡英文",p$Page_Name)
p$Page_Name<-gsub("宋楚瑜找朋友", "宋楚瑜",p$Page_Name)
p$Message<-as.character(p$Message)
p$Hour<-hour(p$Date)
p$Month<-month(p$Date)
p$Day<-p$Date %>% as.Date("%Y/%m/%d")
p$Week<-weekdays(as.Date(p$Date))
p$ID <- seq.int(nrow(p))三、處理熱圖矩陣
data<-p%>%
select(Page_Name,Week,Hour)
data.cyw<-data%>%
filter(Page_Name=="蔡英文")%>%
select(-Page_Name)
data.hgy<-data%>%
filter(Page_Name=="韓國瑜")%>%
select(-Page_Name)
data.scy<-data%>%
filter(Page_Name=="宋楚瑜")%>%
select(-Page_Name)
cyw_matrix<-as.data.frame.matrix(table(data.cyw$Hour,data.cyw$Week))%>%
select(Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday)%>%
data.matrix()
hgy_matrix<-as.data.frame.matrix(table(data.hgy$Hour,data.hgy$Week))%>%
select(Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday)%>%
data.matrix()
scy_matrix<-as.data.frame.matrix(table(data.scy$Hour,data.scy$Week))%>%
select(Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday)%>%
data.matrix()四、熱圖繪製——總統候選人臉書發文時段熱圖
1.蔡英文臉書發文時段
d3heatmap(cyw_matrix,
scale = "column",
dendrogram = "none",
color = "Blues",
xaxis_font_size=13,
yaxis_font_size=13)五、斷詞
#p<-p%>%mutate(linenumber = row_number())
cc=worker(stop_word = "stop_words.txt",user = "user.txt")
book_tokenizer <- function(t) {
lapply(t, function(x) {
tokens <- segment(x,cc)
return(tokens)
})
}
p1<-p%>%
unnest_tokens(word,Message,token=book_tokenizer)
tsai<-p%>%
filter(Page_Name=="蔡英文")%>%
unnest_tokens(word,Message,token=book_tokenizer)
han<-p%>%
filter(Page_Name=="韓國瑜")%>%
unnest_tokens(word,Message,token=book_tokenizer)
song<-p%>%
filter(Page_Name=="宋楚瑜")%>%
unnest_tokens(word,Message,token=book_tokenizer)六、文字雲視覺化呈現
1.蔡英文臉書文字雲圖
tsai.word.fre<-tsai%>%
dplyr::count(word, sort =TRUE)%>%
with(wordcloud(word,n,max.words = 50,
family="STHeitiTC-Medium",
scale=c(6,.6),
colors = brewer.pal(8,"Set2" )))
七、比較蔡英文與韓國瑜臉書內容相似度與主要差異
p.cor<-p1%>%
unnest()%>%
dplyr::count(ID,word,Page_Name) %>%
bind_tf_idf(term = word,document =ID,n = n)%>%
filter(n>2)
p.cor.1<-p.cor%>%
filter(Page_Name%in% c("蔡英文","韓國瑜"))
p.cor.1$Page_Name=ordered(p.cor.1$Page_Name,labels=c("蔡英文","韓國瑜"))
table(p.cor.1$Page_Name)P1.cor<-p.cor.1%>%
dplyr::count(Page_Name,word) %>%
group_by(Page_Name)%>%
spread(Page_Name,n)
ggplot(P1.cor, aes(蔡英文,韓國瑜,color = abs(`蔡英文` - 韓國瑜))) +
geom_abline(color = "gray40", lty =5) +
geom_jitter(alpha = 0.4, size = 2, width = 0.3, height = 0.3)+
scale_y_log10()+
scale_x_log10()+
labs(y ="韓國瑜", x ="蔡英文")+
theme_bw()+
theme(panel.grid =element_blank(),
text=element_text(family="STHeitiTC-Medium",size=12,color="gray40"))+
geom_text(aes(label = word), check_overlap = TRUE, vjust =1.5,family="STHeitiTC-Medium",color="gray35")
##
## Pearson's product-moment correlation
##
## data: P1.cor$蔡英文 and P1.cor$韓國瑜
## t = 22.167, df = 284, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.7492728 0.8349647
## sample estimates:
## cor
## 0.7960747cor=0.7960747,兩位候選人的臉書貼文內容具有顯著差異
八、情緒分析
1.資料清理及LIWC情緒字典導入
p2<- p1%>%
group_by(ID,Day,Page_Name)%>%
dplyr::count(word,sort=TRUE)%>%
filter(!grepl('_',word))%>%
filter(nchar(word)>1)
Pos <- read_file("positive.txt")
Neg <- read_file("negative.txt")
Pos = strsplit(Pos, ",")[[1]]
Neg = strsplit(Neg, ",")[[1]]
Pos = data.frame(word = Pos, sentiment = "positive")
Neg = data.frame(word = Neg, sentiment = "negative")
LIWC = rbind(Pos, Neg)
head(LIWC)
p2 %>% inner_join(LIWC)## Joining, by = "word"## Adding missing grouping variables: `ID`, `Day`, `Page_Name`
## Joining, by = "word"2.候選人臉書貼文情緒字比較
data_full<-p2 %>% select(ID,word) %>%
group_by(ID, Day, Page_Name) %>%
summarise(sentence = paste0(word,collapse = " "))## Adding missing grouping variables: `Day`, `Page_Name`TSAI<-subset(p2,Page_Name=="蔡英文")
HAN<-subset(p2,Page_Name=="韓國瑜")
SONG <-subset(p2,Page_Name=="宋楚瑜")3.候選人臉書情緒分析
tsai_sentiment_count <-TSAI%>%
select(Day,word,n) %>%
inner_join(LIWC) %>%
group_by(Day,sentiment,word) %>%
dplyr::summarise(n=sum(n))## Adding missing grouping variables: `ID`, `Page_Name`## Joining, by = "word"han_sentiment_count <-HAN%>%
select(Day,word,n) %>%
inner_join(LIWC) %>%
group_by(Day,sentiment,word) %>%
dplyr::summarise(n=sum(n))## Adding missing grouping variables: `ID`, `Page_Name`
## Joining, by = "word"song_sentiment_count <-SONG%>%
select(Day,word,n) %>%
inner_join(LIWC) %>%
group_by(Day,sentiment,word) %>%
dplyr::summarise(n=sum(n))## Adding missing grouping variables: `ID`, `Page_Name`
## Joining, by = "word"4.候選人大選期間臉書貼文正負面字頻比較
pic1<-tsai_sentiment_count %>%
ggplot()+
geom_line(aes(x=Day,y=n,colour=sentiment))+
scale_x_date(labels = date_format("%Y/%m"))+
labs(title="蔡英文臉書正負面字頻比較",
y =" ", x =" ")+
theme_bw()+
theme(panel.grid =element_blank())+
theme(plot.title = element_text(hjust = 0.5),
text=element_text(family="STHeitiTC-Medium",size=11))
pic2<-han_sentiment_count %>%
ggplot()+
geom_line(aes(x=Day,y=n,colour=sentiment))+
scale_x_date(labels = date_format("%Y/%m"))+
labs(title="韓國瑜臉書正負面字頻比較",
y =" ", x =" ")+
theme_bw()+
theme(panel.grid =element_blank())+
theme(plot.title = element_text(hjust = 0.5),
text=element_text(family="STHeitiTC-Medium",size=11))
pic3<-song_sentiment_count %>%
ggplot()+
geom_line(aes(x=Day,y=n,colour=sentiment))+
scale_x_date(labels = date_format("%Y/%m"))+
labs(title="宋楚瑜臉書正負面字頻比較",
y =" ", x =" ")+
theme_bw()+
theme(panel.grid =element_blank())+
theme(plot.title = element_text(hjust = 0.5),
text=element_text(family="STHeitiTC-Medium",size=11))
multiplot(pic1,pic2,pic3,cols=1)
5.蔡英文情緒最負面的貼文
tsai_sentiment_count2 <- tsai_sentiment_count %>%
select(Day,word,n) %>%
inner_join(LIWC) %>%
filter(sentiment == "negative") %>%
group_by(Day,sentiment,word) %>%
arrange(n, desc(n))## Adding missing grouping variables: `sentiment`## Joining, by = c("sentiment", "word")## [1] "2019-04-21"## Message
## 1 民主，是台灣人民努力超過半個世紀爭取而來的價值。沒有民主，就沒有令人驕傲的台灣。\n \n我們也從來沒有因為民主，而忽略經濟。讓人民在自由、民主之下，過更好的生活，是負責任的政治人物應有的責任。\n \n參選民主國家的總統，必須具備民主素養。面對質疑，要選總統的人當然得回答問題，而不是設計一個網路投票，去罵別人傻或壞。\n \n郭董事長的作為，恰巧是他輕蔑的「民主」所賦予的權利。在民主的台灣，任何人都可以批評、揶揄、攻擊執政者，但在中國或者所謂「一國兩制」之下，絕對不可以。\n \n郭董事長也許精明於成本利潤的價格，但是你真的不懂民主的價值。如果你至今仍堅持「民主不能當飯吃」，我想請問：中國式的民主，讓新疆再教育營裡的民眾有飯吃，長期被監禁的劉曉波也有飯吃，中國無數被監控、隨時被失蹤的異議人士也有飯吃，但是你真的認為，這是台灣人民吃得下去的飯嗎？\n \n2020年，對於我們和未來的世代將是非常關鍵的時刻。要維持自由民主的現狀，還是被迫進入「一國兩制」的統一進程，需要台灣人民一起做出智慧的選擇。
## 2 本文兩重點：\n\U0001f53a參加區域經濟合作的鑰匙在自己手上\n\U0001f53a改善糧食供應安全的問題已在進行中\n字數總共898個字\n\n\u2705沒耐性的朋友可以直接看最後一段\n \n—\n \n在民主國家，政治人物的發言受到公開檢驗。針對郭董事長在臉書上發表的意見，我說明如下：\n \n#參加區域經濟合作的鑰匙在自己手上\n \n郭董事長說，台灣參加區域經濟合作的鑰匙在北京手上。我要說的是，鑰匙有兩種功能，一種用來把門打開，一種用來把門鎖上。而這把鑰匙就在我們自己手上。\n \n過去國民黨執政，把鑰匙交給北京，把自己關在一個市場裡，把雞蛋放在同個籃子，結果就是低薪、低競爭力，馬總統卸任前，台灣經濟還曾負成長。\n \n我執政後，經濟成長率變正的，最高還曾經連4季破3%。就是因為，這三年來，我把台灣帶回世界，把台灣當中心，向世界佈局。\n \n中國的壓力一直都在，但我們一直很努力。我們跟歐盟、印尼等許多國際夥伴，完成投資保障的雙邊協定，也持續爭取加入CPTPP等多邊經貿協定。這些都是大家一起努力的成果。\n \n現在，東協台商的前1000大，總營收達到3兆6000億元。國際上最重要的企業也紛紛來台灣投資，台商回流更大幅增加。\n \n「分散風險」是經濟學的ABC，郭董事長也知道要跑去美國投資，所以與其說這麼多，不如加入我們佈局全球、投資台灣的行列。\n \n#改善糧食供應安全的問題已在進行中\n \n就像郭董事長自己說的，扭曲發言者原意去做政治操作，就是民粹。\n \n農委會陳主委在全國農業會議的談話，指的是「糧食供應安全」的問題，引用數據是馬政府時期的最新統計。\n \n目的很簡單，在於凸顯「糧食分配不均」跟「提出解決方案」。我執政後，提出解決方案，結合民間資源，擴大辦理食物銀行，也提供各種糧食援助計劃，包括提供米、水果及其他食物供應站。\n \n此外，我們也調升基本工資，替民眾減稅，在追求經濟成長的同時，兼顧公平分配，照顧百姓。\n \n郭董事長把數據移花接木，來指控政府總體經濟表現不如過去。移花接木的事，如果發生在你的公司，相信你一定無法接受。自己無法接受的東西，卻拿來指控別人，我要嚴正地說，政治沒有那麼low。\n \n最後，我要強調的是：民主，就是民主，我們要堅守的就是民主價值，同時，我們也會認真拚經濟。\n \n好了，我回答完問題了。郭董事長，你還沒回答我的問題，我的問題是：\n \n\u2705中國式的民主，讓新疆再教育營裡的民眾有飯吃，長期被監禁的劉曉波也有飯吃，中國無數被監控、隨時被失蹤的異議人士也有飯吃，但是你真的認為，這是台灣人民吃得下去的飯嗎？\n \n#文長要編輯才貼心## Message
## 1 韓市長必須把「國軍是太監」這句話收回去。批評我，我都可以承受，但是打擊國軍士氣的話，我不能接受。\n \n國軍24小時待命，我們在台灣享有言論自由，過自由的生活，都是因為第一線的國軍弟兄姊妹在捍衛這個國家。\n \n我有沒有當過兵，跟國軍有沒有戰力是兩回事。這三年來，國軍的戰力是持續在強化當中，科技的提升，服役環境的改善以及專業人才的培訓，台灣國防實力帶種得很。\n \n汙辱國軍，打擊國軍士氣的事，不要忘了！我是三軍統帥，台灣人民不接受，我也不會接受。\n \n我再說一次，請韓市長把那兩個字收回去。
## 2 在 經濟部的「5+2產業徵才博覽會」台北場上，有200間企業參與，總共5000個職缺，有一半以上起薪超過4萬元。\n \n今天一整天，超過14000人參加，超過8000人投履歷。\n \n這是政府跟民間一起拚經濟的成果，台灣人很努力，沒有人在鬼混。\n \n5+2產業創新已經進入驗收成果的階段，帶來的工作機會，是高收入，又有國際競爭力的工作機會，這就是我們拚經濟的成果！這些工作機會，就是下一個世代最好的卡位機會！\n \n最近我的產業行程很多，蔡教授再幫大家複習，政府拚經濟的成果：\n \n1️⃣外資加碼投資：Facebook、Google、亞馬遜AWS、Microsoft等知名跨國企業，加碼對台投資，持續擴大徵才。\n \n2️⃣台商回流投資：今年台商回流不斷增加，投資總金額已經來到1370億，創造11800個工作機會。\n \n3️⃣新南向政策有成果：東協台商的前1000大，總營收達到3兆6000億元。\n \n\n這些都是真材實料的成績，蔡英文拚經濟，不膨風、不吹牛、不鬼混。政府和民間一起合作，拚出好成績！\n \n#我做事你分享\n#蔡英文拚經濟蔡英文臉書貼文在2019年4月21日負面情緒最高，查看前後一日狀況後發現在4月20日有韓國瑜辱罵國軍事件。
九、網絡圖繪製
1.分詞及整理
p_bigrams <- p1 %>%
unnest_tokens(bigram, word, token = "ngrams", n = 2)
p_bigrams%>%
dplyr::count(bigram,sort = TRUE)
bigrams_separated <- p_bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ")
bigrams_filtered <- bigrams_separated %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word)
bigram_counts <- bigrams_filtered %>%
dplyr::count(word1, word2, sort = TRUE)2.分群：依據Links的Degree
##local-level analysis:分群
#make network undirected,找出所有可能的群
bigram_graph <- bigram_counts %>%
filter(n > 30) %>%
graph_from_data_frame()
net.sym <- as.undirected(bigram_graph, mode= "collapse", edge.attr.comb=list(weight="sum", "ignore"))
cliques(net.sym) # list of cliques
sapply(cliques(net.sym), length) # clique sizes
largest_cliques(net.sym) # cliques with max number of nodes
ceb <- cluster_edge_betweenness(bigram_graph)
deg <- degree(bigram_graph, mode="all") （1）三位總統候選人臉書內容網絡圖
set.seed(3000)
par(mar=c(0,0,0,0))
ggraph(bigram_graph,layout = "fr") +
geom_edge_link(edge_colour ="gray40") +
geom_node_point(aes(size = Popularity),
color = "lightblue3", size =3.5) +
geom_node_text(aes(label = name), colour="gray45",
vjust=1.2,hjust=1,
family="STHeitiTC-Medium") +
theme_void()
（2）三位總統候選人臉書分群網絡圖
set.seed(3000)
par(mar=c(0,0,0,0))
plot(ceb,
bigram_graph,
vertex.size=deg,
vertex.label.family="STHeitiTC-Medium",
vertex.label.dist=1.2,
edge.color="snow3",
edge.width=1,
edge.arrow.size=0,
vertex.label.color = "gray30",
vertex.label.cex = .75
)
（3）蔡英文臉書分群網絡圖
p_bigrams<-tsai%>%
unnest_tokens(bigram, word, token = "ngrams", n = 2)
p_bigrams %>%
dplyr::count(bigram, sort = TRUE)
bigrams_separated <- p_bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ")
bigrams_filtered <- bigrams_separated %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word)
bigram_counts <- bigrams_filtered %>%
dplyr::count(word1, word2, sort = TRUE)
bigram_graph <- bigram_counts %>%
filter(n > 30) %>%
graph_from_data_frame()
set.seed(3000)
par(mar=c(0,0,0,0))
ggraph(bigram_graph,layout = "fr") +
geom_edge_link(edge_colour ="gray40") +
geom_node_point(aes(size = Popularity),
color = "lightblue3", size =3.5) +
geom_node_text(aes(label = name), colour="gray45",
vjust=1.2,hjust=1,
family="STHeitiTC-Medium") +
theme_void()
（4）韓國瑜臉書分群網絡圖
p_bigrams<-han%>%
unnest_tokens(bigram, word, token = "ngrams", n = 2)
p_bigrams %>%
dplyr::count(bigram, sort = TRUE)
bigrams_separated <- p_bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ")
bigrams_filtered <- bigrams_separated %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word)
bigram_counts <- bigrams_filtered %>%
dplyr::count(word1, word2, sort = TRUE)
bigram_graph <- bigram_counts %>%
filter(n > 20) %>%
graph_from_data_frame()
set.seed(3000)
par(mar=c(0,0,0,0))
ggraph(bigram_graph,layout = "fr") +
geom_edge_link(edge_colour ="gray40") +
geom_node_point(aes(size = Popularity),
color = "lightblue3", size =3.5) +
geom_node_text(aes(label = name), colour="gray45",
vjust=1.2,hjust=1,
family="STHeitiTC-Medium") +
theme_void()
（4）宋楚瑜臉書分群網絡圖
p_bigrams<-song%>%
unnest_tokens(bigram, word, token = "ngrams", n = 2)
p_bigrams %>%
dplyr::count(bigram, sort = TRUE)
bigrams_separated <- p_bigrams %>%
separate(bigram, c("word1", "word2"), sep = " ")
bigrams_filtered <- bigrams_separated %>%
filter(!word1 %in% stop_words$word) %>%
filter(!word2 %in% stop_words$word)
bigram_counts <- bigrams_filtered %>%
dplyr::count(word1, word2, sort = TRUE)
bigram_graph <- bigram_counts %>%
filter(n > 10) %>%
graph_from_data_frame()
set.seed(3000)
par(mar=c(0,0,0,0))
ggraph(bigram_graph,layout = "fr") +
geom_edge_link(edge_colour ="gray40") +
geom_node_point(aes(size = Popularity),
color = "lightblue3", size =3.5) +
geom_node_text(aes(label = name), colour="gray45",
vjust=1.2,hjust=1,
family="STHeitiTC-Medium") +
theme_void()
叁.結論
三位總統候選人的臉書貼文內容是有顯著差異的，蔡英文的內容通常比較有國際視野，多涉及到外交、國家安全等層面，可以看得出來很希望讓台灣走出去。而韓國瑜的貼文內容則更多局限在與高雄市在地的一些政策相關，可能很大程度上也與他當時的市長身份有關。至於宋楚瑜則專心注重於投票上，內容多為曝光其所在黨派並引導大家對他進行投票。而在分析總統候選人的貼文情緒後也發現負面詞頻較高的貼文不一定就是在攻擊其他候選人或是背後的黨派，也可能是因為憂國憂民而有所感慨。