第五周：情緒分析練習
heminghsin
4/13/2021
#第五周：情緒分析練習(C組何明信)
Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼## [1] "zh_TW.UTF-8/zh_TW.UTF-8/zh_TW.UTF-8/C/zh_TW.UTF-8/zh_TW.UTF-8"# echo = T,results = 'hide'
packages = c("dplyr", "tidytext", "stringr", "wordcloud2", "ggplot2",'readr','data.table','reshape2','wordcloud','tidyr','scales')
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)library(dplyr)
library(stringr)
library(tidytext)
library(wordcloud2)
library(data.table)
library(ggplot2)
library(reshape2)
library(wordcloud)
library(tidyr)
library(readr)
library(scales)
require(jiebaR)MetaData = fread('~/Social media analysis/ptt_鳳梨_articleMetaData.csv',encoding = 'UTF-8')
Reviews = fread('~/Social media analysis/ptt_鳳梨_articleMetaData.csv',encoding = 'UTF-8')# 再篩一次文章 826 篇
keywords = c('鳳梨','中國','外銷','菠蘿','台灣')
toMatch = paste(keywords,collapse="|")
MetaData = with(MetaData, MetaData[grepl(toMatch,sentence)|grepl(toMatch,artTitle),])
# 挑選文章對應的留言
left_join(MetaData, Reviews[, c("artUrl", "sentence")], by = "artUrl")## artTitle artDate artTime
## 1: Re:[新聞]贊成藻礁公投？洪申翰：非二元選擇的問題 2021/02/26 04:16:16
## 2: [問卦]男生酒醉要小心被男同志甲甲撿屍？ 2021/02/26 04:16:53
## 3: Re:[問卦]日本人澱粉配澱粉怎麼還是多數瘦子 2021/02/26 04:16:55
## 4: [轉錄]華國人不來經營臺灣會變海南或是沖繩 2021/02/26 04:17:30
## 5: [問卦]現在如果有反共義士駕著殲20投誠~我們要? 2021/02/26 04:21:54
## ---
## 13328: Re:[問卦]七年級會害怕戰爭嗎? 2021/03/26 16:47:47
## 13329: [新聞]小英籲產業界一起抗旱節水 2021/03/26 16:49:01
## 13330: Re:[問卦]七年級會害怕戰爭嗎? 2021/03/26 16:53:25
## 13331: Re:[問卦]華春瑩：美國用黑奴採棉花該如何反駁？ 2021/03/26 16:53:30
## 13332: [問卦]現在在中國翻牆合法了嗎 2021/03/26 16:53:42
## artUrl artPoster
## 1: https://www.ptt.cc/bbs/Gossiping/M.1614312979.A.61B.html FlashMan
## 2: https://www.ptt.cc/bbs/Gossiping/M.1614313015.A.DCA.html elmoman
## 3: https://www.ptt.cc/bbs/Gossiping/M.1614313018.A.917.html bluebluelan
## 4: https://www.ptt.cc/bbs/Gossiping/M.1614313051.A.653.html Reewalker
## 5: https://www.ptt.cc/bbs/Gossiping/M.1614313319.A.4B7.html ejeanstone
## ---
## 13328: https://www.ptt.cc/bbs/Gossiping/M.1616777269.A.326.html icoann
## 13329: https://www.ptt.cc/bbs/Gossiping/M.1616777345.A.3E3.html alex1987
## 13330: https://www.ptt.cc/bbs/Gossiping/M.1616777608.A.4A5.html trylin
## 13331: https://www.ptt.cc/bbs/Gossiping/M.1616777612.A.578.html ptt987654321
## 13332: https://www.ptt.cc/bbs/Gossiping/M.1616777624.A.C52.html Yginger1
## artCat commentNum push boo
## 1: Gossiping 84 54 4
## 2: Gossiping 18 9 2
## 3: Gossiping 10 4 0
## 4: Gossiping 263 54 5
## 5: Gossiping 48 32 2
## ---
## 13328: Gossiping 11 7 1
## 13329: Gossiping 0 0 0
## 13330: Gossiping 0 0 0
## 13331: Gossiping 0 0 0
## 13332: Gossiping 0 0 0
## sentence.x
## 1: 內政部政務次長花敬群\n\n當官前->支持居住正義主張課徵屯房稅\n\n當官後->屯房稅是無效且無理的錯誤建議\n\n\n前環保署副署長詹順貴\n\n當官前->環團律師 支持禁用生媒發電\n\n當官後->環評投票贊成蓋深澳電廠\n\n\n農委會主委陳吉仲\n\n當官前->誓死反對萊豬進口\n\n當官後->萊豬很安全吃了不會有事\n\n\n不分區立委洪申翰\n\n當委員前->非核減煤救藻礁\n\n當委員後->我我我\n\n\n\n關心台灣環境的社會團體裡面是不是一堆內奸\n\n隨時準備婊台灣人一把\n\n>完全沒有問題
## 2: 實在太恐怖噁心了\n\n今天看到新聞甲甲居然連異男都肛\n\n［新聞］屁股痛痛的！學弟醉到忘記穿褲子 學長伺機性侵害\nhttps://www.ptt.cc/bbs/Gossiping/M.1614303515.A.F2E.html\n學弟肛內都驗出甲甲洨了還死不承認強姦\n辯說拿自己打手槍的衛生紙擦學弟肛門(?)\n\n台灣正常男生以後是不是更要保護自己\n\n除了酒醉 可能食物飲料還會下藥\n\n被男同志迷姦被強插肛門\n台灣男男性行為愛滋第一名\n被男同志強姦還有機會得愛滋絕症\n\n我好奇的是某版都說男同志約砲so easy\n\n怎麼還會想強姦異男啊？\n\n有卦？\nhttps://i.imgur.com/nINpZEQ.jpg\nhttps://imgur.com/xciFqTZ\nhttps://i.imgur.com/LULd7mZ.jpg\nhttps://i.imgur.com/BFe4Nki.gif
## 3: 日本是澱粉+澱粉 台灣是油脂+澱粉+糖 份量還比人家多 當然更慘\n\n\n炸雞排便當+珍奶\n\n炸雞腿便當+珍奶\n\n炸排骨便當+珍奶\n\n\n下午茶再來個鹽酥雞+手搖飲\n\n\n調味重鹹 身體為了保持電解質平衡就會多吸收水分\n\n光水分就比人家多重了 還不算上肚子那圈油
## 4: 作者: tsuyoshi2501 (Tsuyoshi) 看板: historia\n標題: Re: [請益] 日本侵略韓台沖繩，為何只有沖繩變日本？\n時間: Thu Feb 11 18:24:30 2021\n\n台灣會有現在的樣子真的是歷史機運\n\n因為國民黨只剩下台灣了，所以才把台灣重點發展\n\n給日本或是中國，那只會變成第二個沖繩或是第二個海南島罷了。\n\n國家重點發展的東西是不會放在邊疆離島，\n對日本來說放九州東北就好\n對中國就是珠江長三角深圳\n\n且沒被土改的台灣土地還是在大家族手中\n沒有強迫拿土地換股票，那一定就是繼續搞農業\n\n台灣如果沒有國民黨加上韓戰的歷史絕佳機會\n大概就是熱帶度假島加農業島的命運\n不會生出啥科技聚落的存在。\n\n幻想很美好，現實很骨感\n台灣跟香港就是拿到千年一遇的歷史機運\n一個漁村變成東方之珠\n一個蠻荒小島變成世界半導體重鎮\n\n\n
## 5: 以前反共義士駕著米格機投誠\n\n新聞都會大大的報導~來讚賞一下中華民國自由民主的美好\n\n順便虧一下大陸水深火熱的人民\n\n\n\n如果現在有一位中共軍官駕著殲20要來投誠\n\n表示受夠了中共暴政，嚮往自由所以果斷投奔台灣\n\n降落在松山機場，我們該怎麼做?\n\n\n\n\n1.被當間諜原機遣返回去?順便促進海峽兩岸交流\n\n2.被拱起來當楷模，之後上政論節目當名嘴?\n\n\n還是??
## ---
## 13328: 看你的文章我才害怕我保護的台灣到底有幾個跟你一樣智商在海平面之下\n\n什麼叫做因為守法而上去保衛台灣？\n\n難道你不是台灣人？台灣不是你的國家？\n\n有時候覺得台灣真的很可悲，國際上不承認台灣是國家就算了，連人民也對國家不認同\n\n\n看看美國，任何職業比賽開場就唱國歌\n看看日本，完全以大日本皇民為驕傲\n看看以色列，為了捍衛主權幹翻附近想侵略他們的國家\n\n台灣呢？該死的政府懦弱無能\n\n歐陽娜娜公開叛國還不是活的好好地，羅志祥慶祝中國國慶還住在台北市\n\n這種該辦的不辦，讓台灣的社會大眾毫無國家的認同感，根本比戰爭還恐怖\n\n
## 13329: 1.媒體來源:\n\n中時電子報\n\n2.記者署名:\n\n中國時報 何冠嫻、 崔慈悌\n\n3.完整新聞標題:\n\n小英籲產業界一起抗旱節水\n\n4.完整新聞內文:\n\n蔡英文總統25日受邀出席力晶積成電子銅科新廠動土典禮，感謝力積電願意在台灣投入資\n源進行投資研發。針對近期水情嚴峻，蔡總統表示，政府會積極透過各種方式節水、調度\n水源，期盼產業界能在維持正常生產下，一起來達成節水目標。她向產業界承諾，政府會\n努力維持穩定供水。\n\n蔡英文指出，台灣的「護國群山」已經成形，政府一定會支持大家，盡力幫助大家解決問\n題。她說，最近因為極端氣候，台灣面臨56年來最嚴峻的水情，台中跟苗栗水情燈號將在\n4月6日提升為紅燈。她承諾，政府會積極透過各種方式進行節水調度，也採取多元方式增\n加水源，包括啟用抗旱水井及增加伏流水供應等措施，努力維持穩定供水。\n\n蔡英文並列舉政府的各項準備作為，指從去年至今調度節水累積達8億噸，「大約是4座石\n門水庫的水量」。另政府也完成板二供水計畫、桃竹備援管線工程，確保水資源的穩定調\n度；新竹緊急海淡機組在台中等地啟動海水淡化機組的設置，全面增加新水源；抗旱水井\n也啟用、增加伏流水供應；同時加速再生水廠、淨水設備的設置。\n\n蔡英文強調，防疫經驗告訴我們，只要團結，就能發揮力量，突破難關，「這一次，我們\n也會克服挑戰！」呼籲大家節水，打贏抗旱延長賽。\n\n\n5.完整新聞連結 (或短網址):\nhttps://www.chinatimes.com/newspapers/20210326000515-260114?chdtv\n6.備註:\n\n\n
## 13330: :\n\n你知道最可撥的是啥ㄇ\n不是這些明擺著想當中國人的\n\n而是那些整天喊愛台的政客\n結果也只是掏空台灣\n把錢搬進自己的口袋\n到最後要是真的花生省魔術\n留在鬼島的也只有你我這種可撥韭菜\n哭哭\n\n想當中國人的沒有國家認同感\n那些整天講愛台灣的又有什麼認同感zzzz
## 13331: :\n\n很多人說\n阿美國黑奴時代\n都什麼時候的事情了\n\n可是\n當時柯阿北說\n現在好好的，管他過去幹什麼\n可是被炮翻天耶\n大概被炮了三百多篇有\n\n且如果不是現在進行式就=都什麼時候的事情了\n那當年KMT殺台灣人\n按照同樣的邏輯\n是不是也不要管了\n\n哀\n說穿了\n還是一樣\n他可以你不行\n\n只能說\n一堆人的善惡標準\n不是看事情\n是看人\n\n不過中國要侵略我們\n美國會保護我們\n好像也不應該同標準看待\n\n哀\n
## 13332: https://youtu.be/RSqNoHkHmeE\n中國影片 不喜勿看\n\n今天 這位中國人 公然的 在公開場合說她在看YouTube.\n\n如果我沒記錯的話 在中國翻牆應該是不合法的吧 還是已經合法了\n\n如果還是不合法 那不應該把她抓起來嗎？\n
## sentence.y
## 1: 內政部政務次長花敬群\n\n當官前->支持居住正義主張課徵屯房稅\n\n當官後->屯房稅是無效且無理的錯誤建議\n\n\n前環保署副署長詹順貴\n\n當官前->環團律師 支持禁用生媒發電\n\n當官後->環評投票贊成蓋深澳電廠\n\n\n農委會主委陳吉仲\n\n當官前->誓死反對萊豬進口\n\n當官後->萊豬很安全吃了不會有事\n\n\n不分區立委洪申翰\n\n當委員前->非核減煤救藻礁\n\n當委員後->我我我\n\n\n\n關心台灣環境的社會團體裡面是不是一堆內奸\n\n隨時準備婊台灣人一把\n\n>完全沒有問題
## 2: 實在太恐怖噁心了\n\n今天看到新聞甲甲居然連異男都肛\n\n［新聞］屁股痛痛的！學弟醉到忘記穿褲子 學長伺機性侵害\nhttps://www.ptt.cc/bbs/Gossiping/M.1614303515.A.F2E.html\n學弟肛內都驗出甲甲洨了還死不承認強姦\n辯說拿自己打手槍的衛生紙擦學弟肛門(?)\n\n台灣正常男生以後是不是更要保護自己\n\n除了酒醉 可能食物飲料還會下藥\n\n被男同志迷姦被強插肛門\n台灣男男性行為愛滋第一名\n被男同志強姦還有機會得愛滋絕症\n\n我好奇的是某版都說男同志約砲so easy\n\n怎麼還會想強姦異男啊？\n\n有卦？\nhttps://i.imgur.com/nINpZEQ.jpg\nhttps://imgur.com/xciFqTZ\nhttps://i.imgur.com/LULd7mZ.jpg\nhttps://i.imgur.com/BFe4Nki.gif
## 3: 日本是澱粉+澱粉 台灣是油脂+澱粉+糖 份量還比人家多 當然更慘\n\n\n炸雞排便當+珍奶\n\n炸雞腿便當+珍奶\n\n炸排骨便當+珍奶\n\n\n下午茶再來個鹽酥雞+手搖飲\n\n\n調味重鹹 身體為了保持電解質平衡就會多吸收水分\n\n光水分就比人家多重了 還不算上肚子那圈油
## 4: 作者: tsuyoshi2501 (Tsuyoshi) 看板: historia\n標題: Re: [請益] 日本侵略韓台沖繩，為何只有沖繩變日本？\n時間: Thu Feb 11 18:24:30 2021\n\n台灣會有現在的樣子真的是歷史機運\n\n因為國民黨只剩下台灣了，所以才把台灣重點發展\n\n給日本或是中國，那只會變成第二個沖繩或是第二個海南島罷了。\n\n國家重點發展的東西是不會放在邊疆離島，\n對日本來說放九州東北就好\n對中國就是珠江長三角深圳\n\n且沒被土改的台灣土地還是在大家族手中\n沒有強迫拿土地換股票，那一定就是繼續搞農業\n\n台灣如果沒有國民黨加上韓戰的歷史絕佳機會\n大概就是熱帶度假島加農業島的命運\n不會生出啥科技聚落的存在。\n\n幻想很美好，現實很骨感\n台灣跟香港就是拿到千年一遇的歷史機運\n一個漁村變成東方之珠\n一個蠻荒小島變成世界半導體重鎮\n\n\n
## 5: 以前反共義士駕著米格機投誠\n\n新聞都會大大的報導~來讚賞一下中華民國自由民主的美好\n\n順便虧一下大陸水深火熱的人民\n\n\n\n如果現在有一位中共軍官駕著殲20要來投誠\n\n表示受夠了中共暴政，嚮往自由所以果斷投奔台灣\n\n降落在松山機場，我們該怎麼做?\n\n\n\n\n1.被當間諜原機遣返回去?順便促進海峽兩岸交流\n\n2.被拱起來當楷模，之後上政論節目當名嘴?\n\n\n還是??
## ---
## 13328: 看你的文章我才害怕我保護的台灣到底有幾個跟你一樣智商在海平面之下\n\n什麼叫做因為守法而上去保衛台灣？\n\n難道你不是台灣人？台灣不是你的國家？\n\n有時候覺得台灣真的很可悲，國際上不承認台灣是國家就算了，連人民也對國家不認同\n\n\n看看美國，任何職業比賽開場就唱國歌\n看看日本，完全以大日本皇民為驕傲\n看看以色列，為了捍衛主權幹翻附近想侵略他們的國家\n\n台灣呢？該死的政府懦弱無能\n\n歐陽娜娜公開叛國還不是活的好好地，羅志祥慶祝中國國慶還住在台北市\n\n這種該辦的不辦，讓台灣的社會大眾毫無國家的認同感，根本比戰爭還恐怖\n\n
## 13329: 1.媒體來源:\n\n中時電子報\n\n2.記者署名:\n\n中國時報 何冠嫻、 崔慈悌\n\n3.完整新聞標題:\n\n小英籲產業界一起抗旱節水\n\n4.完整新聞內文:\n\n蔡英文總統25日受邀出席力晶積成電子銅科新廠動土典禮，感謝力積電願意在台灣投入資\n源進行投資研發。針對近期水情嚴峻，蔡總統表示，政府會積極透過各種方式節水、調度\n水源，期盼產業界能在維持正常生產下，一起來達成節水目標。她向產業界承諾，政府會\n努力維持穩定供水。\n\n蔡英文指出，台灣的「護國群山」已經成形，政府一定會支持大家，盡力幫助大家解決問\n題。她說，最近因為極端氣候，台灣面臨56年來最嚴峻的水情，台中跟苗栗水情燈號將在\n4月6日提升為紅燈。她承諾，政府會積極透過各種方式進行節水調度，也採取多元方式增\n加水源，包括啟用抗旱水井及增加伏流水供應等措施，努力維持穩定供水。\n\n蔡英文並列舉政府的各項準備作為，指從去年至今調度節水累積達8億噸，「大約是4座石\n門水庫的水量」。另政府也完成板二供水計畫、桃竹備援管線工程，確保水資源的穩定調\n度；新竹緊急海淡機組在台中等地啟動海水淡化機組的設置，全面增加新水源；抗旱水井\n也啟用、增加伏流水供應；同時加速再生水廠、淨水設備的設置。\n\n蔡英文強調，防疫經驗告訴我們，只要團結，就能發揮力量，突破難關，「這一次，我們\n也會克服挑戰！」呼籲大家節水，打贏抗旱延長賽。\n\n\n5.完整新聞連結 (或短網址):\nhttps://www.chinatimes.com/newspapers/20210326000515-260114?chdtv\n6.備註:\n\n\n
## 13330: :\n\n你知道最可撥的是啥ㄇ\n不是這些明擺著想當中國人的\n\n而是那些整天喊愛台的政客\n結果也只是掏空台灣\n把錢搬進自己的口袋\n到最後要是真的花生省魔術\n留在鬼島的也只有你我這種可撥韭菜\n哭哭\n\n想當中國人的沒有國家認同感\n那些整天講愛台灣的又有什麼認同感zzzz
## 13331: :\n\n很多人說\n阿美國黑奴時代\n都什麼時候的事情了\n\n可是\n當時柯阿北說\n現在好好的，管他過去幹什麼\n可是被炮翻天耶\n大概被炮了三百多篇有\n\n且如果不是現在進行式就=都什麼時候的事情了\n那當年KMT殺台灣人\n按照同樣的邏輯\n是不是也不要管了\n\n哀\n說穿了\n還是一樣\n他可以你不行\n\n只能說\n一堆人的善惡標準\n不是看事情\n是看人\n\n不過中國要侵略我們\n美國會保護我們\n好像也不應該同標準看待\n\n哀\n
## 13332: https://youtu.be/RSqNoHkHmeE\n中國影片 不喜勿看\n\n今天 這位中國人 公然的 在公開場合說她在看YouTube.\n\n如果我沒記錯的話 在中國翻牆應該是不合法的吧 還是已經合法了\n\n如果還是不合法 那不應該把她抓起來嗎？\n# 加入自定義的字典
jieba_tokenizer <- worker(user="Social media analysis/week5_sentiment_analysis1/dict/user_dict.txt", stop_word = "Social media analysis/week5_sentiment_analysis1/dict/stop_words.txt")
# 設定斷詞function
customized_tokenizer <- function(t) {
lapply(t, function(x) {
tokens <- segment(x, jieba_tokenizer)
return(tokens)
})
}# 把文章和留言的斷詞結果併在一起
MToken <- MetaData %>% unnest_tokens(word, sentence, token=customized_tokenizer)
RToken <- Reviews %>% unnest_tokens(word, sentence, token=customized_tokenizer)
# 把資料併在一起
data <- rbind(MToken[,c("artDate","artUrl", "word")],RToken[,c("artDate","artUrl", "word")]) # 格式化日期欄位
data$artDate= data$artDate %>% as.Date("%Y/%m/%d")
# 過濾特殊字元
data_select = data %>%
filter(!grepl('[[:punct:]]',word)) %>% # 去標點符號
filter(!grepl("['^0-9a-z']",word)) %>% # 去英文、數字
filter(nchar(.$word)>1)
# 算每天不同字的詞頻
# word_count:artDate,word,count
word_count <- data_select %>%
select(artDate,word) %>%
group_by(artDate,word) %>%
summarise(count=n()) %>% # 算字詞單篇總數用summarise
filter(count>10) %>% # 過濾出現太少次的字
arrange(desc(count))## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.word_count## # A tibble: 60,468 x 3
## # Groups: artDate [29]
## artDate word count
## <date> <chr> <int>
## 1 2021-02-26 鳳梨 1928
## 2 2021-02-28 台灣 1806
## 3 2021-03-26 中國 1732
## 4 2021-03-02 台灣 1722
## 5 2021-03-01 台灣 1658
## 6 2021-03-03 台灣 1634
## 7 2021-02-26 台灣 1612
## 8 2021-03-05 台灣 1610
## 9 2021-03-11 台灣 1606
## 10 2021-02-28 鳳梨 1570
## # … with 60,458 more rowsP <- read_file("Social media analysis/week5_sentiment_analysis1/dict/liwc/positive.txt") # 正向字典txt檔
N <- read_file("Social media analysis/week5_sentiment_analysis1/dict/liwc/negative.txt") # 負向字典txt檔
#字典txt檔讀進來是一整個字串
typeof(P)## [1] "character"# 將字串依,分割
# strsplit回傳list , 我們取出list中的第一個元素
P = strsplit(P, ",")[[1]]
N = strsplit(N, ",")[[1]]
# 建立dataframe 有兩個欄位word,sentiments，word欄位內容是字典向量
P = data.frame(word = P, sentiment = "positive") #664
N = data.frame(word = N, sentiment = "negative") #1047
# 把兩個字典拼在一起
LIWC = rbind(P, N)
# 檢視字典
head(LIWC)## word sentiment
## 1 一流 positive
## 2 下定決心 positive
## 3 不拘小節 positive
## 4 不費力 positive
## 5 不錯 positive
## 6 主動 positive＃新聞發佈後約於2/27討論度最高
MetaData$artDate= MetaData$artDate %>% as.Date("%Y/%m/%d")
MetaData %>%
group_by(artDate) %>%
summarise(count = n()) %>%
ggplot()+
geom_line(aes(x=artDate,y=count))+
scale_x_date(labels = date_format("%m/%d"))
# sentiment_count:artDate,sentiment,count
sentiment_count = data_select %>%
select(artDate,word) %>%
inner_join(LIWC) %>%
group_by(artDate,sentiment) %>%
summarise(count=n())## Joining, by = "word"## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.# 檢視資料的日期區間
range(sentiment_count$artDate) #"2021-02-26" "2021-03-26"## [1] "2021-02-26" "2021-03-26"3/2以負面情緒最高，此時政府也開始宣達相關配套措施
sentiment_count %>%
ggplot()+
geom_line(aes(x=artDate,y=count,colour=sentiment))+
scale_x_date(labels = date_format("%m/%d"),
limits = as.Date(c('2021-02-26','2021-03-26'))
)+
# 加上標示日期的線
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2021-03-03'))
[1]])),colour = "red") 
將情緒分數標準化後再畫一次圖，可以發現大部分都是負面情緒居多，但在3/16出現正面情緒，推測可能是外銷轉內銷成功。
sentiment_count %>%
# 標準化的部分
group_by(artDate) %>%
mutate(ratio = count/sum(count)) %>%
# 畫圖的部分
ggplot()+
geom_line(aes(x=artDate,y=ratio,colour=sentiment))+
scale_x_date(labels = date_format("%m/%d"),
limits = as.Date(c('2021-02-26','2021-03-26'))
)+
# 加上標示日期的線
geom_vline(aes(xintercept = as.numeric(artDate[which(sentiment_count$artDate == as.Date('2021-03-16'))
[1]])),colour = "red")
# 查看每天的情緒分數排名
sentiment_count %>%
select(count,artDate) %>%
group_by(artDate) %>%
summarise(sum = sum(count)) %>%
arrange(desc(sum))## # A tibble: 29 x 2
## artDate sum
## <date> <int>
## 1 2021-03-03 9225
## 2 2021-03-11 9152
## 3 2021-02-28 9095
## 4 2021-03-10 8576
## 5 2021-03-19 8437
## 6 2021-03-26 8370
## 7 2021-03-04 8315
## 8 2021-03-21 8221
## 9 2021-03-25 8215
## 10 2021-03-16 8000
## # … with 19 more rows文字雲
# 畫出文字雲03/16
word_count %>%
filter(!(word %in% c("鳳梨"))) %>%
filter(artDate == as.Date('2021-03-16')) %>%
select(word,count) %>%
group_by(word) %>%
summarise(count = sum(count)) %>%
arrange(desc(count)) %>%
filter(count>100) %>% # 過濾出現太少次的字
wordcloud2()## Adding missing grouping variables: `artDate`# 畫出文字雲03/02
plot_0302 = word_count %>%
filter(!(word %in% c("鳳梨"))) %>%
filter(artDate == as.Date('2021-03-02')) %>%
select(word,count) %>%
group_by(word) %>%
summarise(count = sum(count)) %>%
arrange(desc(count)) %>%
filter(count>120) %>% # 過濾出現太少次的字
wordcloud2()## Adding missing grouping variables: `artDate`# sentiment_sum:word,sentiment,sum
sentiment_sum <-
word_count %>%
inner_join(LIWC) %>%
group_by(word,sentiment) %>%
summarise(
sum = sum(count)
) %>%
arrange(desc(sum)) %>%
data.frame() ## Joining, by = "word"## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.library(showtext) #安装此包前需要在mac中按照XQuartz，link在下文## Loading required package: sysfonts## Loading required package: showtextdbshowtext_auto()
font_add("PingFangSC-Regular",regular = "/System/Library/Fonts/PingFang.ttc") #第一个参数是根据字体随便取个名字，regular参数是相应字体在电脑中的文件library(ggplot2)
old <-theme_light() + theme(text = element_text(family = "wqy-microhei"))
theme_set(old)sentiment_sum %>%
top_n(30,wt = sum) %>%
mutate(word = reorder(word, sum)) %>%
ggplot(aes(word, sum, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free_y") +
labs(y = "Contribution to sentiment",
x = NULL) +
theme(text=element_text(size=14))+
coord_flip()
sentiment_sum %>%
acast(word ~ sentiment, value.var = "sum", fill = 0) %>%
comparison.cloud(
colors = c("salmon", "#72bcd4"), # positive negative
max.words = 50)
sentiment_sum_select <-
word_count %>%
filter(artDate == as.Date('2021-03-16`')) %>%
inner_join(LIWC) %>%
group_by(word,sentiment) %>%
summarise(
sum = sum(count)
) %>%
arrange(desc(sum)) %>%
data.frame() ## Joining, by = "word"## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.sentiment_sum_select %>%
top_n(30,wt = sum) %>%
ungroup() %>%
mutate(word = reorder(word, sum)) %>%
ggplot(aes(word, sum, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free_y") +
labs(y = "Contribution to sentiment 0316",
x = NULL) +
theme(text=element_text(size=14))+
coord_flip()
sentiment_sum_select %>%
acast(word ~ sentiment, value.var = "sum", fill = 0) %>%
comparison.cloud(
colors = c("salmon", "#72bcd4"), # positive negative
max.words = 50)
# 依據情緒值的正負比例歸類文章
article_type =
data_select %>%
inner_join(LIWC) %>%
group_by(artUrl,sentiment) %>%
summarise(count=n()) %>%
spread(sentiment,count,fill = 0) %>% #把正負面情緒展開，缺值補0
mutate(type = case_when(positive > negative ~ "positive",
TRUE ~ "negative")) %>%
data.frame() ## Joining, by = "word"## `summarise()` has grouped output by 'artUrl'. You can override using the `.groups` argument.# 看一下正負比例的文章各有幾篇
article_type %>%
group_by(type) %>%
summarise(count = n())## # A tibble: 2 x 2
## type count
## <chr> <int>
## 1 negative 22393
## 2 positive 15222#
article_type_date = left_join(article_type[,c("artUrl", "type")], MetaData[,c("artUrl", "artDate")], by = "artUrl")
article_type_date %>%
group_by(artDate,type) %>%
summarise(count = n()) %>%
ggplot(aes(x = artDate, y = count, fill = type)) +
geom_bar(stat = "identity", position = "dodge")+
scale_x_date(labels = date_format("%m/%d"),
limits = as.Date(c('2021-02-26','2021-03-26'))
)## `summarise()` has grouped output by 'artDate'. You can override using the `.groups` argument.## Warning: Removed 4 rows containing missing values (geom_bar).
# negative_article:artUrl,word
negative_article <-
article_type %>%
filter(type=="negative")%>%
select(artUrl) %>%
left_join(data_select[,c("artUrl", "word")], by = "artUrl")
# positive_article:artUrl,word
positive_article <-
article_type %>%
filter(type=="positive")%>%
select(artUrl) %>%
left_join(data_select[,c("artUrl", "word")], by = "artUrl")# 負面情緒關鍵字貢獻圖
negative_article %>%
inner_join(LIWC) %>%
group_by(word,sentiment) %>%
summarise(
sum = n()
)%>%
arrange(desc(sum)) %>%
data.frame() %>%
top_n(30,wt = sum) %>%
ungroup() %>%
mutate(word = reorder(word, sum)) %>%
ggplot(aes(word, sum, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free_y") +
labs(y = "Contribution to negative sentiment",
x = NULL) +
theme(text=element_text(size=14))+
coord_flip()## Joining, by = "word"## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.
# 正面情緒關鍵字貢獻圖
positive_article %>%
inner_join(LIWC) %>%
group_by(word,sentiment) %>%
summarise(
sum = n()
)%>%
arrange(desc(sum)) %>%
data.frame() %>%
top_n(30,wt = sum) %>%
ungroup() %>%
mutate(word = reorder(word, sum)) %>%
ggplot(aes(word, sum, fill = sentiment)) +
geom_col(show.legend = FALSE) +
facet_wrap(~sentiment, scales = "free_y") +
labs(y = "Contribution to positive sentiment",
x = NULL) +
theme(text=element_text(size=10))+
coord_flip()## Joining, by = "word"## `summarise()` has grouped output by 'word'. You can override using the `.groups` argument.