A.動機和分析目的

在疫情期間，人心惶惶之下，政府也推出許多政策來幫助人民度過這次的難關，在去年2020年1月20日成立中央流行疫情指揮中心以來，除快速整備各項防疫應變措施，並努力防止疫情擴散。而隨著疫情嚴峻衝擊到許多產業、事業，政府即以「防疫、紓困、振興」等政策。而在今年5月初以來，隨著疫情的大爆發，台灣也已經實施並延長了第三級防疫警戒。而在這期間，政府也於6月3號，發布紓困4.0 五大措施： 一、加發弱勢民眾生活補助 二、擴大急難紓困 三、未滿2歲孩童家庭防疫補貼 四、照顧服務單位紓困補貼 五、住宿式機構及社福事業單位紓困

因此，我們想知道在這段時間大家對於政府的紓困政策有甚麼看法?情緒又是如何?討論的主題又是以何種為主?社群討論分布圖又會是何種樣子?

B.資料集的描述

B-1 安裝package

packages = c("dplyr","ggplot2","rtweet" ,"xml2", "httr", "jsonlite", "data.tree", "NLP", "igraph","sentimentr","tidytext","wordcloud2","DiagrammeR","dplyr","topicmodels","RColorBrewer","showtext","topicmodels","jiebaR","servr","htmlwidgets","webshot","tm","igraph")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)
library(data.table)
library(topicmodels)
library(LDAvis)
library(stringr)
library(tm)
library(webshot)
library(htmlwidgets)
library(servr)
library(jiebaR)
library(dplyr)
library(purrr)
library(tidytext)
library(ggplot2)
library(showtext)
require(RColorBrewer)
library(scales)
library(wordcloud2)
library(readr)
library(tidyr)
library(igraph)
require(RColorBrewer)
mycolors <- colorRampPalette(brewer.pal(8, "Set3"))(20)
showtext_auto(enable = T)
font_path = "TaipeiSansTCBeta-Regular.ttf"
font_name = tools::file_path_sans_ext(basename(font_path))
font_add(font_name, font_path)

B-2 資料收集

metadata <- fread('./5policy_articleMetaData.csv',encoding = "UTF-8")
reviews <- fread('./5policy_articleReviews.csv',encoding = "UTF-8")

B-3 資料集的描述

資料基本介紹

  • 資料來源: 文字平台收集PTT 政黑/Gossip/版文章、回覆
  • 資料集：5policy_articleMetaData.csv、5policy_articleReviews.csv
  • 關鍵字：政策、紓困、補助、補貼
  • 資料時間：2021-05-01 ~ 2021-06-08

查看資料

head(metadata)
##                                                     artTitle    artDate
## 1:                      [新聞]蔡英文盤點政策：加薪減稅挺勞工 2021/05/01
## 2: [新聞]BBC中美關係：拜登中國政策仍在「重新評估」的三大方面 2021/05/02
## 3:                [新聞]質疑民進黨能源政策柯文哲問：如何善後 2021/05/02
## 4:                [新聞]影／隔空交鋒楊志良批評陳時中防疫政策 2021/05/03
## 5:                      [新聞]民眾黨討論能源政策柯P:不蓋核四 2021/05/03
## 6:                [新聞]獨家》張老師基金會涉詐領菸捐補助檢廉 2021/05/03
##     artTime                                                   artUrl  artPoster
## 1: 13:28:51 https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html borondawon
## 2: 04:53:06 https://www.ptt.cc/bbs/Gossiping/M.1619931192.A.143.html bigDwinsch
## 3: 09:49:16 https://www.ptt.cc/bbs/Gossiping/M.1619948959.A.711.html    qqq5566
## 4: 08:26:19 https://www.ptt.cc/bbs/Gossiping/M.1620030382.A.6D5.html     jiouje
## 5: 10:58:17 https://www.ptt.cc/bbs/Gossiping/M.1620039499.A.AC7.html  huskymilk
## 6: 13:01:05 https://www.ptt.cc/bbs/Gossiping/M.1620046867.A.AC4.html hank811020
##       artCat commentNum push boo
## 1: Gossiping        210   24 105
## 2: Gossiping          3    1   0
## 3: Gossiping         35   10   9
## 4: Gossiping         18    6   7
## 5: Gossiping         36   15   7
## 6: Gossiping         11    8   0
##                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                sentence
## 1:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           蔡英文盤點政策：加薪減稅挺勞工　全民共享經濟果實\n\n蘋果新聞網  林麒瑋、周彥妤／台北報導\n1小時前\n\n五一勞動節，蔡英文盤點勞工政策。翻攝蔡英文臉書\n\n\n今（1日）是五一勞動節，總統蔡英文盤點各項勞工政策，包含法案的通過、法制的進展，以及相關的加薪、減稅等。行政院長蘇貞昌則強調，台灣經濟成長率今年第一季8.16％，創下近10年來單季新高，強調政府會繼續拚經濟，並透過減稅、增加育兒津貼、健全社會福利，讓民眾一起享受經濟成長的果實。\n\n\n蔡英文在臉書發文指出，勞工支撐起台灣的經濟，這幾年來，政府也完善法制、加薪減稅，努力挺勞工。包含通過《勞工職業災害保險及保護法》，整合各類職災補償制度，將可以打造更完整的職業災害保障體系。\n\n蔡英文表示，政府也陸續完成《勞動事件法》及《中高齡者及高齡者就業促進法》的立法，也修法保障派遣勞工的權益。加薪、基本工資連續5年調升，22K正式走入歷史，此外也鼓勵企業加薪。最後，減稅，提高所得稅四大標準扣除額後，今年不課稅的每人基本生活費也調高7000元，調幅是歷年最高，希望能減輕勞工的負擔。\n\n\n蔡英文表示，台灣經濟的基本面不錯，今年第一季經濟成長率概估值更是超過8％，創下10年來單季新高。這些成長的果實，都應該多回饋給辛苦的勞工朋友。\n\n蔡英文也提醒，拚經濟的前提是維持著防疫表現，面對疫情變化，不能掉以輕心。假期間如果有出門，一定要戴好口罩、落實防疫措施。\n\n蘇貞昌強調今年第一季經濟成長率8.16％，是十年來的單季新高。翻攝蘇貞昌臉書\n\n蘇貞昌也指出，今年第一季的經濟成長率8.16％，這是10年來的單季新高。台灣在百年大疫的威脅下撐過去，經濟越挫越勇，去年台灣的經濟成長3.11％，領先所有已開發國家，許多外銀都預測台灣今年全年成長率會高達5％，這是全民響應防疫、國際大廠投資台灣、辛苦打拚的成果。蘇貞昌強調，政府會繼續為大家拚經濟，也會透過減稅、增加育兒津貼、健全社會福利，讓大家一起享受經濟成長的果實。\n\n\n民進黨發言人顏若芳表示，在屬於勞動者的日子裡，感謝、肯定每位勞工朋友，對台灣經濟與社會的貢獻；民進黨一直以來都與勞工朋友站在一起，關心勞工處境，注重勞工權益。\n\n她指出，勞動節前夕，政府兌現《勞工職業災害保險及保護法》單獨立法的承諾；5年來，民進黨政府持續透過勞動政策與立法，致力提高薪資、促進就業，完善勞動體制。\n\n顏若芳也舉例，保障勞工基本生活水準，蔡政府年年提高基本工資，月薪從20008元調高到24000元，時薪從120元調高到160元，相較國民黨執政的漲幅15.8%及26.3%，蔡英文執政5年漲幅已近20%及33%，不管月薪及時薪的調整，民進黨執政5年，都比國民黨8年還高，更打破前總統馬英九制定月薪22K的低薪魔咒。\n\n她也說，民進黨政府未來也會綜合考量社會經濟情勢，讓勞工薪資更符社會期待水準；年金保障上，廣泛蒐整意見，持續與社會溝通，絕對是首要之務，政府絕對會負起最終的給付責任。\nhttps://tw.appledaily.com/politics/20210501/OWUZDBFOFVF2VLW5OPH5UOZQZA/\n感謝小英  讚嘆小英\n\n我看有超多勞工都在臉書感謝總統  真的很有感！\n\n台灣勞工真的賺大錢了！\n\n投給蔡英文  真的投對了！\n\n\n\n
## 2: 1.媒體來源:\nBBC\n\n2.記者署名:\nBBC繁中\n\n3.完整新聞標題:\n中美關係：拜登中國政策仍在「重新評估」的三大方面\n\n4.完整新聞內文:\n\n拜登政府就任百日以來，儘管美國內靠增強自身經濟科技實力、外靠加強同盟關係應對中\n國挑戰的戰略框架已經清晰化，但是很多具體政策領域的執行層面內容仍然繼續空白。\n\n甚至有越來越多的批評人士指出，拜登政府沿用川普政府中國政策的做法，已經對美國\n帶來潛在危險。\n\n另有知情人士表示，拜登政府遲遲未能拿出新政策，可能有難言之隱。\n\n中國政策「空泛」批評\n\n各方注意到，拜登總統在就職百日的國會演說中頻頻談及與首要「戰略競爭對手」中國的\n關係。他甚至定義這是一場「21世紀的民主制度與專制制度爭奪全球經濟主導權的鬥爭」\n\n除理論講述之外，在實際行動上，拜登政府也對外加強印太盟友關係，對內大力強調加強\n自身競爭力——投資半導體和人工智能（智慧）等關鍵科技領域來<U+51D6>備應對未來美中競爭\n\n不過，已經有人對拜登政府面對如此重大的任務和挑戰，百日之後仍然停留在框架層面而\n具體執行細節匱乏，甚至在重大領域繼續沿用川普時期政策提出了批評。\n\n批評人士還指出，目前白宮的術語就是仍然在 「重新評估」。\n\n有分析認為，目前白宮迫切需要拿出對付中國的大政方針多數仍集中在政經層面——主要\n包括關稅、供應鏈安全和對中國投資等三大政策領域。\n\n中國政策仍在「重新評估」\n\n美國國內批評人士認為，拜登政府在如何對付中國的問題上遲遲無法拿出明確具體政策，\n對美國的經濟和工商界來說都意味著巨大潛在風險和損失。\n\n共和黨參議員羅姆尼（Mitt Romney）就公開指責說，他不相信拜登政府在如何對付「志\n在主導世界的中國」問題上已經有了一套全面戰略。\n\n另有不願透露姓名的國會議員也在拜登國會演說之後告訴路透社記者：「（對付中國）我\n們沒有靜觀其變的奢侈與時間。我們需要具體的政策和實際的行動」。\n\n白宮方面沒有對上述批評做出正式回應。\n\n有民主黨人士私下表示，儘管新政府已經上任百日，但是也有難言之隱——很多關鍵政府\n職位仍然空置，未能招募到適合人選，因此可能影響到具體政策的制定與推進。\n\n拜登政府迄今仍未正式任命駐中國大使。另外，將直接主管對中國技術出口控制的商務部\n工業與安全署負責人位置也仍空置。\n\n貿易關稅戰\n\n拜登政府目前仍在繼續執行川普政府時期推出的對價值約四千億美元的中國商品徵收額\n外關稅的政策。\n\n雖然白宮方面表示正在對上述政策進行「全面細緻的評估」，但是評估過程似乎沒有設定\n時間限。\n\n新任美國貿易代表戴琪（Katherine Chi Tai）最近在一次媒體訪問中表示，「沒有做好\n取消額外關稅的<U+51D6>備」，因為關稅讓美方在談判中增加了「槓桿力」。\n\n與此同時，已經有美國智庫開始質疑額外關稅政策的有效性。美國稅務基金會（Tax\nFoundation）就發表分析文章認為，額外關稅為美國製造業平添了高達800億美元的額外\n成本，對美國經濟造成巨大負面影響。另外，中國迄今也未能完成2020年1月所達成貿易\n協定中購買美國商品的指標。\n\n全球供應鏈\n\n拜登政府今年二月啟動了對美國全球供應鏈的「百日評估」，旨在最終制定出一套能長期\n確保關鍵商品物資供應鏈安全、多元、可靠的政策。\n\n關鍵商品物資包括醫藥品、半導體、電動車電池、稀土等等。目前美國的全球供應鏈與中\n國關係緊密。\n\n在這項全球供應鏈的政府全面評估中，白宮要求國防、商務、能源、農業、運輸、國土安\n全、衛生和人力服務等各主要政府部門在2022年2月前拿出一套各自管轄領域中的全球供\n應鏈安全的報告。\n\n金融投資禁令\n\n另外一項特朗普政府時期出籠、目前仍在一定程度上懸而未決的政策就是美國如何限制資\n金流向由中國政府控制、特別是中共軍方控制的企業。\n\n2020年11月12日，美國前總統特朗普簽署行政令，禁止美國企業和個人購買35家被定性為\n中共軍工企業（CCMC）的上市股票，或包括上述中國公司股票的其它金融產品。\n\n美國財政部公布的中共軍工企業（CCMC）禁令名單最近又從35增加到44家，其中包括華為\n、中芯國際和中石化等國際知名企業。\n\n然而，很多與中國有投資和商貿關係的美國企業都急迫希望政府就制裁令中的很多細節法\n律和規則做出進一步澄清，比如如何定義「交易」等概念。\n\n分析人士指出，目前的禁令仍然存在很多法律灰色地帶，讓很多美國個人和企業很難作出\n未來投資抉擇。\n\n有分析指出，這方面的具體政策或許要等到2022年夏天，甚至下半年才可能初現端倪。\n\n5.完整新聞連結 (或短網址):\nhttps://www.bbc.com/zhongwen/trad/world-56943912\n6.備註:\n\n駐中大使空缺耶\n
## 3:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  1.媒體來源:\n中時\n\n2.記者署名:\n張立勳\n\n3.完整新聞標題:\n能源政策 柯文哲問：如何善後 電價上漲沒講清楚\n\n4.完整新聞內文:\n台北市長柯文哲2日質疑民進黨能源政策，不滿民進黨對於減煤、增氣、展綠、非核的轉型\n目標，未向人民說明如果到時候做不到要怎麼處理，甚至沒說清楚電價將上漲。\n\n民眾黨今舉辦未來能源轉型研討會，柯文哲致詞時盤點民進黨能源轉型目標，包括減煤、增\n氣、展綠、非核，2025年燃煤降到30％，燃氣增加到50％，再生能源增加到20％，核能要全\n部停止，離2025年剩4年，再生能源的裝置容量是5.8％，4年內要增至20％，他質疑看不到\n民進黨政府在期程上到底是長什麼樣子，如果到時候做不到要怎麼處理。\n\n柯文哲表示，使用天燃氣發電雖然是比較乾淨，但還是會產生二氧化碳，就全世界零碳排放\n的目標，起初我們制定2030年減25％、2050減50％，現在看起來全世界的趨勢是零碳排放，\n慢慢碳關稅的做法一定會出現，台灣只是地球村一份子，沒辦法獨立於世界之外，台灣是相\n當貿易導向的國家，當歐美國家用碳關稅概念處理時，我們要怎麼應付？\n\n他指出，使用天燃氣發電比較乾淨，但價格是差0.8元，當以燒煤改為燒天燃氣發電，電費\n將會上漲，民進黨政府根本沒有向民眾說明講清楚電價是會上漲的。\n\n柯文哲還提到，台灣用電不是很均勻，如果用智慧電表、差別費率加上智慧電網，「削峰填\n谷」就很容易實現，但奇怪過去20年來沒看過政府處理。\n\n他說，同樣的藻礁也是一個題目，如果核一、二、三不延役，核四不蓋，天燃氣發電要占50\n％，藻礁就變成不得不的選擇，可是要問為什麼民進黨政府要把台灣人民逼到走投無路，\n\n柯認為，台積電當然是護國神山，但的確是高耗電、耗水產業，當然也很努力節水、節電，\n可是比起其他產業還是相當耗水電，要把台積電留在台灣，整個產業配比就是大問題，因為\n工業用電占掉用電量的一半。\n\n5.完整新聞連結 (或短網址):\nhttps://www.chinatimes.com/realtimenews/20210502001853-260407?chdtv\n6.備註:
## 4:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              影／隔空交鋒 楊志良批評陳時中防疫政策\n\n2021-05-03 10:13 攝影中心 記者曾原信／台北即時報導\nhttps://udn.com/news/story/120940/5429422\n衛福部長陳時中今天上午前往廣播節目談華航諾富特群聚案，巧合的是，同一時間前衛生\n署長楊志良也在同一大樓接受另一廣播節目專訪，兩人沒有互動，僅眼神致意，相隔遙遠\n，但針對指揮中心防疫政策，楊志良認為群聚感染是可預期的，暗批雙標，而陳時中受訪\n時則回應，政策都可以討論。\n\n\n\n\n看到華航群聚案 楊又出來啦\n
## 5:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  1.媒體來源:華視\n\n\n2.記者署名:王源澤 張道詠 報導\n\n\n3.完整新聞標題:民眾黨討論能源政策 柯P:不蓋核四\n\n\n4.完整新聞內文:\nhttps://www.youtube.com/watch?v=-pdwTckDduw\n台北市長柯文哲，今(2)日參加自家民眾黨舉辦的能源轉型研討會，大談他對核四的看法\n以及民眾黨的能源規劃。他認為藍綠都用民粹的方式在處理能源轉型議題，其實還是要回\n歸到如何解決問題。對核四，他明確表態認為不要蓋。而他也說到，台積電雖然是護國神\n山，但也確實是耗電耗水的產業，該怎麼因應，都還得再討論。\n\n台北市長柯文哲，以民眾黨黨主席身分，出席自家的，能源轉型研討會，或許是一直以來\n，被抨擊在能源政策上，沒有確定規畫，讓柯文哲也不得不親上火線，台北市長柯文哲說\n：「所以坦白講，核四蓋跟不蓋都不是一個，一個喊口號的題目，這也是為什麼，當時我\n在議會會不太高興，就是說，我個人是主張不要蓋，另外就是一旦台灣出現核災，我們台\n灣大概就是滅國了。」\n\n柯文哲正面表態反核四，而反對的理由，來自自身醫生經驗，他認為核災疏散真的太困難\n，不過雖然不蓋核四，他也認為，企業用電難以估計，台北市長柯文哲說：「台積電當然\n是護國神山，可是它真的是一個，高耗水高耗電的產業，當然它也很努力的節水節電，我\n也知道它們在環保，是一個模範的產業，可是終究它比起其他產業，它還是耗電相當高耗\n水相當多，所以如果大家想要把，台積電留在台灣的時候，產業的配比就是一個大問題。\n」\n\n台北市長柯文哲說：「核四不蓋天然氣發電要占50%，那藻礁就變成不得不的選擇，可是\n我們要問的是，為什麼民進黨政府，要把台灣人民逼到走投無路，反核的也不一定就是民\n進黨，反而是藍綠兩黨在綁架台灣的民意。」民眾要超越藍綠，在論壇之後，或許也得端\n出，能源規劃藍圖，才能讓支持者安心。\n\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.cts.com.tw/cts/politics/202105/202105022040745.html\n6.備註:\n之前說柯文哲對於核四反覆的人應該要看一下這篇，他明確表但反對核四商轉，原因是一\n但發生核災疏散不及，但也要討論產業能源配比。\n
## 6:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    1.媒體來源:\n自由時報\n\n\n2.記者署名:\n錢利忠\n\n\n3.完整新聞標題:\n獨家》張老師基金會涉詐領菸捐補助 檢廉秘密搜索、3主管交保\n\n\n4.完整新聞內文:\n〔記者錢利忠／台北報導〕我國最具規模的輔導團體之一「張老師基金會」，驚爆涉嫌假\n造資料，詐領衛生福利部國民健康署菸捐補助專案維護合約驗收款；士林地檢署檢察官陳\n貞卉會同廉政署及台北市刑大發動搜索，約談戒菸專線服務中心主任蘇庭進等多人，訊後\n依詐欺、偽造文書及個資法等罪，分別諭令5萬至8萬元不等金額交保。\n\n檢廉獲報，2018至2019年間，張老師基金會受國健署委託，辦理戒菸專線等服務，經費來\n源則為菸品健康福利捐；蘇庭進及戒菸專線服務中心行政組長吳建興、諮商組長蔡幸紋等\n人，卻涉嫌編造不實名目，向國健署詐取專案驗收補助。\n\n蘇庭進訊後被諭令8萬元交保、吳建興及蔡幸紋等2人，各諭令5萬元交保；涉嫌詐領的不\n法金額仍待檢廉釐清中。\n\n亞洲首創的國健署戒菸專線服務中心，於2003年成立，多年來利用菸捐收入為經費，委託\n張老師基金會推動戒菸宣導服務，提供戒菸諮詢及資訊，包括電話戒菸諮詢、LINE戒菸諮\n詢、官網自助戒菸、轉介合作、資源連結，以及菸害宣導等6大服務，幫忙癮君子擬訂戒\n菸策略及計畫。\n\n根據國健署官網統計，自2003成立開始至爆發詐領菸捐補助的2019年底為止，戒菸專線所\n提供的戒菸電話諮詢量，多達132萬9271人次。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/society/breakingnews/3519790\n6.備註:\n3人偵訊後 檢察官裁定交保\n\n

查看資料分布

data_count_by_date <- metadata %>% 
  group_by(artDate) %>% 
  summarise(count = n()) %>% 
  arrange(desc(count))

plot_date <- 
  data_count_by_date %>% 
  ggplot(aes(x = as.Date(artDate), y = count)) +
  geom_line(size = 0.5) + 
  geom_vline(xintercept = as.numeric(as.Date("2021-05-27")), col='red') +
  geom_vline(xintercept = as.numeric(as.Date("2021-06-03")), col='red') +
  geom_vline(xintercept = as.numeric(as.Date("2021-06-04")), col='red') +
  scale_x_date(labels = date_format("%Y/%m/%d" )) +
  ggtitle("ptt八卦板 討論文章數") + 
  xlab("日期") + 
  ylab("數量") + 
  theme(text = element_text(family = "TaipeiSansTCBeta-Regular")) #加入中文字型設定，避免中文字顯示錯誤。

plot_date

2021-05-27、2021-06-03、2021-06-04 有高峰

2021-05-27 : 國發會於行政院院會陳報紓困4.0方案

2021-06-03 : 行政院疫情紓困4.0正式通過

#subset(metadata,artDate == '2021/06/04')

C.資料的分析過程

c-1 資料前處理

# 斷詞
jieba_tokenizer = worker(stop_word = './dict/stop_words.txt', user = './dict/dict.txt')
news_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      # 去掉字串長度爲1的詞彙
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

tokens <- metadata %>%
  unnest_tokens(word, sentence, token=news_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
  count(artUrl, artDate, word) %>%
  rename(count=n)
tokens %>% head(20)
##                                                       artUrl    artDate
##  1: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  2: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  3: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  4: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  5: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  6: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  7: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  8: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##  9: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 10: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 11: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 12: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 13: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 14: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 15: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 16: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 17: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 18: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 19: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
## 20: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html 2021/05/01
##                           word count
##  1:                       十年     1
##  2:                       口罩     1
##  3:                       大疫     1
##  4:                       大廠     1
##  5:                       小英     1
##  6:                       小時     1
##  7:                       已近     1
##  8: 中高齡者及高齡者就業促進法     1
##  9:                 五一勞動節     2
## 10:                       及時     1
## 11:                       支撐     1
## 12:                       日子     1
## 13:                       月薪     3
## 14:                       水準     1
## 15:                       出門     1
## 16:                       加薪     5
## 17:                       包含     2
## 18:                       台北     1
## 19:                       台灣     8
## 20:                       四大     1
comments_tokens <- reviews %>%
  unnest_tokens(word, cmtContent, token=news_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
  count(artUrl, artDate, word) %>%
  rename(count=n)

c-2 建立 Document-Term Matrix

dtm <-tokens %>% cast_dtm(artUrl, word, count)
dtm
## <<DocumentTermMatrix (documents: 909, terms: 13632)>>
## Non-/sparse entries: 50393/12341095
## Sparsity           : 100%
## Maximal term length: 13
## Weighting          : term frequency (tf)

c-3 訓練 LDA 模型

ldas = c()
topics = c(4,5,6)
for(topic in topics){
  start_time <- Sys.time()
  lda <- LDA(dtm, k = topic, control = list(seed = 2021))
  ldas =c(ldas,lda)
  print(paste(topic ,paste("topic(s) and use time is ", Sys.time() -start_time)))
  #save(ldas,file = "ldas_result.rdata") # 將模型輸出成檔案
}
## [1] "4 topic(s) and use time is  9.20027494430542"
## [1] "5 topic(s) and use time is  12.4083690643311"
## [1] "6 topic(s) and use time is  20.9181439876556"
# load("ldas_result.rdata")

選定主題數量

data.frame(k = topics, perplex = map_dbl(ldas, topicmodels::perplexity)) %>%
  ggplot(aes(k, perplex)) +
  geom_point() +
  geom_line() +
  labs(title = "Evaluating LDA topic models",
       subtitle = "Optimal number of topics (smaller is better)",
       x = "Number of topics",
       y = "Perplexity")

topicmodels_json_ldavis <- function(fitted, doc_term){
    require(LDAvis)
    require(slam)
  
    ###以下function 用來解決，主題數多會出現NA的問題
    ### 參考 https://github.com/cpsievert/LDAvis/commit/c7234d71168b1e946a361bc00593bc5c4bf8e57e
    ls_LDA = function (phi){
      jensenShannon <- function(x, y) {
        m <- 0.5 * (x + y)
        lhs <- ifelse(x == 0, 0, x * (log(x) - log(m+1e-16)))
        rhs <- ifelse(y == 0, 0, y * (log(y) - log(m+1e-16)))
        0.5 * sum(lhs) + 0.5 * sum(rhs)
      }
      dist.mat <- proxy::dist(x = phi, method = jensenShannon)
      pca.fit <- stats::cmdscale(dist.mat, k = 2)
      data.frame(x = pca.fit[, 1], y = pca.fit[, 2])
    }
  
      # Find required quantities
      phi <- as.matrix(posterior(fitted)$terms)
      theta <- as.matrix(posterior(fitted)$topics)
      vocab <- colnames(phi)
      term_freq <- slam::col_sums(doc_term)
  
      # Convert to json
      json_lda <- LDAvis::createJSON(phi = phi, theta = theta,
                                     vocab = vocab,
                                     doc.length = as.vector(table(doc_term$i)),
                                     term.frequency = term_freq, mds.method = ls_LDA)
  
      return(json_lda)
}

D.視覺化的分析結果與解釋

D-1 文字雲

tokens_counts <- tokens %>% 
  filter(nchar(.$word)>1) %>%
  group_by(word) %>% 
  summarise(sum = n()) %>% 
  filter(sum>1) %>%
  arrange(desc(sum))
# 印出最常見的20個詞彙
head(tokens_counts,20)
## # A tibble: 20 x 2
##    word       sum
##    <chr>    <int>
##  1 紓困       525
##  2 政府       374
##  3 補助       341
##  4 疫情       327
##  5 政策       192
##  6 防疫       188
##  7 疫苗       170
##  8 台灣       166
##  9 申請       133
## 10 勞工       132
## 11 影響       132
## 12 記者       127
## 13 方案       122
## 14 補貼       116
## 15 網址       111
## 16 相關       106
## 17 新聞標題   105
## 18 貸款       104
## 19 行政院     102
## 20 工作       101
tokens_counts %>% filter(sum>100) %>% wordcloud2()

D-2 探討政府政策議題的情緒關係

D-2-1 先以推噓文來看鄉民對於政府政策的看法

reviews_status =reviews %>% mutate(commentStatus = ifelse(cmtStatus == "推",1,
                          ifelse(cmtStatus=="噓",-1,
                                                  0)))
table(reviews_status$commentStatus) %>% plot

依照日期呈現推噓文的聲量

reviews_status %>% group_by(artDate) %>%
  summarise(commentStatus = sum(commentStatus)) %>%
  arrange(desc(commentStatus)) %>%
  ggplot(aes(as.Date(artDate),commentStatus))+
  geom_line()+
      scale_x_date(labels = date_format("%Y/%m/%d" )) +
  geom_vline(xintercept = as.numeric(as.Date("2021-05-27")), col='red')+
  geom_vline(xintercept = as.numeric(as.Date("2021-06-03")), col='red') +
  geom_vline(xintercept = as.numeric(as.Date("2021-06-06")), col='red') +
  geom_vline(xintercept = as.numeric(as.Date("2021-05-29")), col='blue')

以下探討幾個時間點推噓的文章

2021-05-27(文章最多) : 國發會於行政院院會陳報紓困4.0方案 => 推略大於噓

推>噓的文章：
reviews_status %>% 
  filter(artDate=="2021/05/27")%>% 
  group_by(artTitle) %>%
  summarise(commentStatus = sum(commentStatus)) %>%
  arrange(desc(commentStatus)) %>%
  head()
## # A tibble: 6 x 2
##   artTitle                                 commentStatus
##   <chr>                                            <dbl>
## 1 [問卦]為啥小黃補助都是無條件                       106
## 2 [問卦]紓困2100億，你可以分多少？                    99
## 3 [新聞]紓困條例綠提最高8400億藍不奉陪                88
## 4 [問卦]紓困跟補助好幾億為什麼不拿來買疫苗            46
## 5 [討論]好像沒人在意紓困4.0                           44
## 6 [問卦]為什麼發現金紓困那麼難?                       43
推<噓文章：
reviews_status %>% 
  filter(artDate=="2021/05/27")%>% 
  group_by(artTitle) %>%
  summarise(commentStatus = sum(commentStatus)) %>%
  arrange(commentStatus) %>%
  head()
## # A tibble: 6 x 2
##   artTitle                                                         commentStatus
##   <chr>                                                                    <dbl>
## 1 [新聞]痛批國民黨杯葛紓困條例民進黨：「防疫優先」根本說一套做一套          -196
## 2 [新聞]政院拍板紓困4.0再推10萬元勞工紓困貸款                               -131
## 3 [新聞]紓困4.0發現金導遊計程車司機等最高領3萬                              -131
## 4 [新聞]政院紓困「開倉濟眾」個人補貼最高3萬元                                -92
## 5 [新聞]紓困4.0｜「加快加強加碼」3原則救內需　                               -46
## 6 [問卦]八卦板是不是該發起拒絕紓困的抗議(發p)                                 -5

堆>噓的文章中大多都是如「為啥小黃補助都是無條件 」、「紓困跟補助好幾億為什麼不拿來買疫苗」的負面文章。而噓>推的文章中都是關於紓困4.0的新聞。

因此，對紓困4.0政策，大部分人抱持著負面的態度。

2021-05-29 => 噓>推的文章

噓>推的文章
negative_reviews <- reviews_status %>% 
  filter(artDate=="2021/05/29")%>% 
  group_by(artTitle) %>%
  summarise(commentStatus = sum(commentStatus)) %>%
  filter(commentStatus<0)

negative_reviews
## # A tibble: 8 x 2
##   artTitle                                              commentStatus
##   <chr>                                                         <dbl>
## 1 [問卦]小攤商說可以領紓困3萬?                                     -1
## 2 [問卦]台北市補助到底在幹嘛？                                     -2
## 3 [問卦]計程車補助三萬被靠北不夠？                                 -1
## 4 [新聞]3+11隔離政策惹議陳時中：我負責                           -138
## 5 [新聞]我國疫苗政策兩大原則：由中央政府與原廠                    -97
## 6 [新聞]遭嗆砸6300億紓困不如買疫苗政院回擊柯                     -176
## 7 [新聞]糗大了！柯文哲喊6千億紓困不如買疫苗遭真相狠打臉          -763
## 8 [新聞]蘇貞昌向蔡英文報告紓困：總統全力支持                      -10

[新聞]糗大了！柯文哲喊6千億紓困不如買疫苗遭真相狠打臉，此篇新聞被噓爆

柯文哲「6千億紓困不如買疫苗」事件: 柯文哲於5/29表示紓困4.0新增編列了千億元，直呼「綁樁腳也不用花這麼多錢，政治還是要有良心」，並表明與其花6千多億搞紓困，不如挪一筆錢買國際上買的到的疫苗。 匿名知名人事打臉: 提出的紓困4.0特別預算只新增了2千1百億元，並非柯文哲所指的6千億，且從去年就開始執行的紓困1.0到紓困3.0計畫中，本來就囊括了採購、研發疫苗的預算。

網友回覆: 「不是啊又答非所問了」、「垃圾中央政府」、「超前部屬個鳥蛋」、「三立正常發揮」、「2100不拿去買疫苗拿去大撒幣？」等大多為對此新聞的負面留言。

被噓多的文章留言：
subset(reviews_status,artTitle==negative_reviews$artTitle[6])[,c(8,10)]
##      cmtStatus                                        cmtContent
##   1:         →                               :不是啊又答非所問了
##   2:        噓                       :兩千億也夠拳台灣人打兩劑惹
##   3:        噓                       :羅秉成是在回答甚麼????XDDD
##   4:         →                                   :超前部署個鳥蛋
##   5:        推                             :支持柯文哲2024當總統
##  ---                                                            
## 704:        噓 :一堆白癡以為買疫苗跟上菜市場買菜一樣反正現在疫苗
## 705:         →     :隨便你喊喊了一堆智障就高潮了喊了買到我好棒棒
## 706:         →             :喊了買不到綠共卡疫苗這麼香不喊爆才怪
## 707:        噓                                        :可憐啊...
## 708:         →                                     :垃圾中央政府

2021-06-03 行政院疫情紓困4.0正式通過 => 推大於噓

推>噓的文章
reviews_status %>% 
  filter(artDate=="2021/06/03")%>% 
  group_by(artTitle) %>%
  summarise(commentStatus = sum(commentStatus)) %>%
  arrange(desc(commentStatus)) %>%
  head()
## # A tibble: 6 x 2
##   artTitle                                     commentStatus
##   <chr>                                                <dbl>
## 1 [新聞]陳沖：紓困4.0不如發1個月無條件基本收入           276
## 2 [問卦]這兩年紓困預算近兆結果我只領到2000？             104
## 3 [問卦]紓困擴大到730萬人了，你各位可以領多少?            57
## 4 [問卦]勞工紓困貸款到底能幹嘛？                          57
## 5 Re:[問卦]沒領到紓困金！！                               46
## 6 [問卦]農漁民紓困每人一萬元？                            33

被堆的文章大多是批評紓困4.0的文章

2021-06-06 推最多

temp = reviews_status %>% 
  filter(artDate=="2021/06/06")%>% 
  group_by(artTitle) %>%
  summarise(commentStatus = sum(commentStatus)) %>%
  arrange(desc(commentStatus)) %>%
  head()

temp
## # A tibble: 6 x 2
##   artTitle                                      commentStatus
##   <chr>                                                 <dbl>
## 1 [問卦]PTT有紓困方案嗎                                  1168
## 2 Re:[問卦]衛福部紓困網頁進去了！                         143
## 3 [新聞]全民普發1萬元現金紓困？　最快通過時               104
## 4 [新聞]全民免費接種北市統一補助診所人頭費                 61
## 5 [問卦]紓困到現在沒拿半毛是正常的？                       50
## 6 [問卦]有沒有省小錢(普篩)賠大錢(紓困4.0)的八卦            48

PTT有紓困方案嗎 => 造成此天推這麼多的原因

「PTT紓困方案」事件: 有一名網友自稱在板中已達到小富階級，要為返不了鄉、打不到疫苗、領不到紓困金的鄉民發放紓困金，推噓→都發稅前100P，不重複200位。

網友回覆: 「推」、「錢錢」、「p幣紓困」、「爸爸」等留言。

文章留言
subset(reviews_status,artTitle==temp$artTitle[1])[,c(8,10)]
##       cmtStatus  cmtContent
##    1:         →         :推
##    2:         →       :到嘿
##    3:        推         :錢
##    4:        推         :錢
##    5:        推         :推
##   ---                      
## 1282:        推         :帥
## 1283:        推         :推
## 1284:        推 :意外收到3Q
## 1285:        推         :推
## 1286:        推 :嗚嗚救救我

D-2-2 使用LIWC中文情緒字典分析文章情緒

# 準備LIWC中文情緒字典
p <- read_file('./dict/positive.txt')
n <- read_file('./dict/negative.txt')
positive <- strsplit(p, "[,]")[[1]]
negative <- strsplit(n, "[,]")[[1]]
positive <- data.frame(word = positive, sentiments = "positive")
negative <- data.frame(word = negative, sentiemtns = "negative")
colnames(negative) = c("word","sentiment")
colnames(positive) = c("word","sentiment")
LIWC_ch <- rbind(positive, negative)
# 將articles 和comment 的 token結合
tokens = rbind(tokens,comments_tokens)

sentiment = tokens %>%
  filter(nchar(.$word)>1) %>%
  group_by(word) %>% 
  summarise(sum = n()) %>% 
  filter(sum>1) %>%
  arrange(desc(sum))%>%
  inner_join(LIWC_ch)
## Joining, by = "word"
# 繪製出圖表
plot_table<-sentiment %>%
  group_by(sentiment) %>%
  summarise(count=sum(sum)) 
# interaction(source, sentiment)
plot_table %>%
  ggplot(aes( sentiment,count,fill=sentiment))+
  geom_bar(stat="identity", width=0.5)

負面情緒大於正面情緒

查看正面以及負面的情緒字

tokens %>% 
  count(word)%>%
  inner_join(LIWC_ch) %>%
  group_by(sentiment) %>%
  top_n(10,wt = n) %>%
  ungroup() %>% 
  mutate(word = reorder(word, n)) %>%
  ggplot(aes(word, n, 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()
## Joining, by = "word"

正面情緒字有支持、重要、希望、英雄等

負面情緒字有問題、垃圾、可憐、嚴重等

繪製情緒走勢圖

sentiment= tokens %>%
   filter(nchar(.$word)>1) %>%
  inner_join(LIWC_ch)
## Joining, by = "word"
sentiment%>%
  mutate(sentiment = ifelse(sentiment == "positive",1,-1)) %>%group_by(artDate)%>%
  summarise(sentiment = sum(sentiment)) %>%
  ggplot() +
  geom_line(aes(as.Date(artDate),sentiment), size = 0.8)+
  geom_vline(xintercept = as.numeric(as.Date("2021-05-27")), col='red')+
  scale_x_date(labels = date_format("%Y/%m/%d"))

2021-05-27國發會於行政院院會陳報紓困4.0方案 ＝> 負面情緒最多

bigram

jieba_bigram <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      bigram<- ngrams(tokens, 2)
      bigram <- lapply(bigram, paste, collapse = " ")
      unlist(bigram)
    }
  })
}
# 以bigram斷詞
comments_bigram <- reviews %>%
  unnest_tokens(bigram, cmtContent, token = jieba_bigram) %>%
    select(artTitle,artDate,artUrl,artPoster,bigram)

articles_bigram <- metadata %>%
  unnest_tokens(bigram,sentence, token = jieba_bigram)%>%
    select(artTitle,artDate,artUrl,artPoster,bigram)

 article_comment_bigram = rbind(articles_bigram,comments_bigram)
# 載入各種字典
user_dict <- scan(file = "./dict/dict.txt", what=character(),sep='\n', 
                   encoding='utf-8',fileEncoding='utf-8')
stop_words_df <- fread(file = "./dict/stop_words.txt", sep='\n'
                   ,encoding='UTF-8', colClasses="character")
negation_words <- scan(file = "./dict/negation.txt", what=character(),sep='\n')
# ngram 結合 情緒分析
bigrams_separated <- article_comment_bigram %>%
  filter(!str_detect(bigram, regex("[0-9a-zA-Z]"))) %>%
  separate(bigram, c("word1", "word2"), sep = " ")
# 並選出word2爲情緒詞的bigram
#去除wrod1與word2都是stop word
bigrams_separated  <- bigrams_separated %>%
  filter(!(word1 %in% stop_words & word2 %in% stop_words)) %>%
    merge(LIWC_ch , by.x='word2', by.y='word')
article_comment_sentiment_bigrams <- bigrams_separated %>% select(artDate,artTitle,word1, word2,   sentiment)
# 將positive與negative給予情緒值
article_comment_sentiment_bigrams <- article_comment_sentiment_bigrams %>% rename(sentiment_tag = sentiment)
article_comment_sentiment_bigrams <- article_comment_sentiment_bigrams %>% 
  mutate(sentiment = ifelse(sentiment_tag == "positive",1,-1)) %>%
  select( artDate, word1, word2, sentiment_tag, sentiment)
# 如果在情緒詞前出現的是否定詞的話，則將他的情緒對調
article_comment_sentiment_bigrams_negated <- article_comment_sentiment_bigrams %>%
  mutate(sentiment=ifelse(word1 %in% negation_words, -1*sentiment, sentiment)) %>%
  mutate(sentiment_tag=ifelse(sentiment>0, "positive", "negative"))

繪製否定詞改變後的情緒走勢圖

article_comment_sentiment_bigrams_negated %>%
  mutate(sentiment = ifelse(sentiment_tag == "positive",1,-1)) %>%group_by(artDate)%>%
  summarise(sentiment = sum(sentiment)) %>%
  ggplot() +
  geom_line(aes(as.Date(artDate),sentiment), size = 0.8,color ="black")+
  geom_vline(xintercept = as.numeric(as.Date("2021-05-27")), col='red')+
  geom_vline(xintercept = as.numeric(as.Date("2021-05-29")), col='red')+
  scale_x_date(labels = date_format("%Y/%m/%d"))

2021-05-27 及 2021-05-29 負面情緒最多

小結：從留言的推噓來看以及利用LIWC字典分析文章正負面情緒，我們可以看到民眾對於紓困4.0政策，是抱持的負面的態度。

D-3 視覺化 LDA

# 視覺化 LDA
the_lda = ldas[[1]]
# json_res <- topicmodels_json_ldavis(the_lda,dtm)
# serVis(json_res,open.browser = T)
# serVis(json_res, out.dir = "vis", open.browser = T)
# writeLines(iconv(readLines("./vis/lda.json"), to = "UTF8"))
topics_words <- tidy(the_lda, matrix = "beta") # 注意，在tidy function裡面要使用"beta"來取出Phi矩陣。
colnames(topics_words) <- c("topic", "term", "phi")
topics_words %>% arrange(desc(phi)) %>% head(10)
## # A tibble: 10 x 3
##    topic term     phi
##    <int> <chr>  <dbl>
##  1     2 紓困  0.0376
##  2     4 紓困  0.0339
##  3     3 疫苗  0.0282
##  4     4 補助  0.0191
##  5     4 政府  0.0157
##  6     1 台灣  0.0150
##  7     1 政策  0.0143
##  8     3 疫情  0.0138
##  9     2 疫情  0.0128
## 10     2 補助  0.0126

D-3-1 4個主題的組成

topics_words %>%
  group_by(topic) %>%
  top_n(10, phi) %>%
  ungroup() %>%
  ggplot(aes(x = reorder_within(term,phi,topic), y = phi, fill = as.factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered()

# 對主題進行命名
topics_name = c("台灣疫情與國際情勢", "紓困補助方案", "疫情紓困預算案", "紓困政策規劃")
  • topic1 台灣疫情與國際關係﹔台灣、中國、美國……
  • topic2 紓困補助方案﹔行政院、申請、特別、預算……
  • topic3 疫情紓困預算案﹔疫苗、防疫、指揮中心……
  • topic4 紓困政策規劃﹔勞工、紓困金、員工、補助……
topics_words$topic <- topics_name[topics_words$topic]

topics_words %>%
  group_by(topic) %>%
  top_n(10, phi) %>%
  ungroup() %>%
  ggplot(aes(x = reorder_within(term,phi,topic), y = phi, fill = as.factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered()

tmResult <- posterior(the_lda)
doc_pro <- tmResult$topics
document_topics <- doc_pro[metadata$artUrl,]
document_topics_df =data.frame(document_topics)
colnames(document_topics_df) = topics_name
rownames(document_topics_df) = NULL
news_topic = cbind(metadata,document_topics_df)
# news_topic %>%
#   arrange(desc(`疫情紓困預算案`)) %>%head(10)

D-3-2 暸解主題數量在不同時間點的變化

news_topic %>% 
  mutate(artDate = as.Date(artDate)) %>%
  group_by(artDate = format(artDate,'%Y%m%d')) %>%
  summarise_if(is.numeric, sum, na.rm = TRUE) %>%
  melt(id.vars = c("artDate", "commentNum", "push", "boo"))%>%
  ggplot( aes(x=artDate, y=value, fill=variable)) +
  geom_bar(stat = "identity") + ylab("value") +
  scale_fill_manual(values=mycolors[c(1,5,8,12)])+
  theme(axis.text.x = element_text(angle = 90, hjust = 1))
## Warning in melt(., id.vars = c("artDate", "commentNum", "push", "boo")): The
## melt generic in data.table has been passed a tbl_df and will attempt to redirect
## to the relevant reshape2 method; please note that reshape2 is deprecated, and
## this redirection is now deprecated as well. To continue using melt methods from
## reshape2 while both libraries are attached, e.g. melt.list, you can prepend the
## namespace like reshape2::melt(.). In the next version, this warning will become
## an error.

在 5/26 總統表示要政院與國會加快紓困方案的進度、不得延遲，可以看到在這之前只有零星討論，但這之後與疫情紓困相關的討論大量增加。5/30中央疫情指揮中心發表了已採購疫苗的新聞稿，推測此時大部分的討論集中在疫苗相關的議題，因此對紓困的討論大量減少，直到 6/3 公佈紓困4.0的五大措施、紓困金開始發放，討論熱度才回升。

D-3-3 暸解各主題比例在不同時間點的變化

### 暸解主題在不同時間點的變化
news_topic %>%
  mutate(artDate = as.Date(artDate)) %>% 
  filter( !format(artDate,'%Y%m%d') < 20210526)%>%
  group_by(artDate = format(artDate,'%Y%m%d')) %>%
  summarise_if(is.numeric, sum, na.rm = TRUE) %>%
  melt(id.vars = c("artDate", "commentNum", "push", "boo"))%>%
  group_by(artDate)%>%
  mutate(total_value =sum(value))%>%
  ggplot( aes(x=artDate, y=value/total_value, fill=variable)) + 
  geom_bar(stat = "identity") + ylab("proportion") + 
    scale_fill_manual(values=mycolors[c(1,5,8,12)])+
    theme(axis.text.x = element_text(angle = 90, hjust = 1))
## Warning in melt(., id.vars = c("artDate", "commentNum", "push", "boo")): The
## melt generic in data.table has been passed a tbl_df and will attempt to redirect
## to the relevant reshape2 method; please note that reshape2 is deprecated, and
## this redirection is now deprecated as well. To continue using melt methods from
## reshape2 while both libraries are attached, e.g. melt.list, you can prepend the
## namespace like reshape2::melt(.). In the next version, this warning will become
## an error.

可以看到針對紓困政策執行面相關主題的討論變化較大，而疫情情勢與補助相關的主題則都維持一定比例，可能是因為政策相關的主題文章數量容易隨著政府釋出消息的時間點波動，而疫情消息與補助的需求在疫情期間內變化相對穩定。

D-3-4 取出代表主題(topic)

每篇文章拿gamma值最大的topic當該文章的topic

# 在tidy function中使用參數"gamma"來取得 theta矩陣
vaccine_topics <- tidy(the_lda, matrix="gamma") %>% # document topic gamma
                  group_by(document) %>%
                  top_n(1, wt=gamma)
vaccine_topics
## # A tibble: 909 x 3
## # Groups:   document [909]
##    document                                                 topic gamma
##    <chr>                                                    <int> <dbl>
##  1 https://www.ptt.cc/bbs/Gossiping/M.1619931192.A.143.html     1 1.00 
##  2 https://www.ptt.cc/bbs/Gossiping/M.1619948959.A.711.html     1 0.999
##  3 https://www.ptt.cc/bbs/Gossiping/M.1620039499.A.AC7.html     1 0.999
##  4 https://www.ptt.cc/bbs/Gossiping/M.1620245607.A.CAD.html     1 0.859
##  5 https://www.ptt.cc/bbs/Gossiping/M.1620267766.A.8FF.html     1 0.796
##  6 https://www.ptt.cc/bbs/Gossiping/M.1620275674.A.1FA.html     1 0.700
##  7 https://www.ptt.cc/bbs/Gossiping/M.1620369361.A.71D.html     1 1.00 
##  8 https://www.ptt.cc/bbs/Gossiping/M.1620712267.A.59C.html     1 0.992
##  9 https://www.ptt.cc/bbs/Gossiping/M.1620732267.A.FFE.html     1 0.901
## 10 https://www.ptt.cc/bbs/Gossiping/M.1620739050.A.106.html     1 0.995
## # ... with 899 more rows

D-3-5 資料內容探索

posts_topic <- merge(x = metadata, y = vaccine_topics, by.x = "artUrl", by.y="document")

# 看一下各主題在說甚麼
set.seed(123)
posts_topic %>% # 主題二
  filter(topic==2) %>%
  select(artTitle) %>%
  unique() %>%
  sample_n(5)
##                                        artTitle
## 1:                     [問卦]可以發放肉體紓困嗎
## 2:                    [爆卦]LIVE紓困4.0方案報告
## 3: [新聞]紓困4.0｜遊覽車司機領3萬　公會不滿補貼
## 4:  [新聞]政院：已提案再增紓困預算2,100億元盼立
## 5:        Re:[新聞]立院通過紓困條例　上限8400億
posts_topic %>% # 主題四
  filter(topic==4) %>%
  select(artTitle) %>%
  unique() %>%
  sample_n(5)
##                                      artTitle
## 1:       [問卦]為什麼紓困慘業就是紓困員工呢？
## 2: [問卦]請問一般勞工紓困方案要看哪一張圖啊？
## 3:                       [問卦]館長談紓困不公
## 4:         [問卦]查詢明天是否紓困匯入郵局帳戶
## 5:         [問卦]這次政府紓困方案會不會太大方

這次我們把討論焦點放在紓困補助與政策規劃上，從主題分布大概可以看到兩類觀點：

  • 主題二： > 對於政府釋出的紓困政策進行相關討論，有些文章甚至帶有嘲諷態度，「可以發放肉體紓困嗎？」、「LIVE紓困4.0方案報告」、「紓困4.0」、「立院通過紓困條例」

  • 主題四： > 大部分是討論紓困政策的規劃，如「為什麼紓困慘業就是紓困員工呢？」、「請問一般勞工紓困方案要看哪一張？」、「館長談紓困不公」、「查詢明天是否紓困匯入郵局帳戶」、「這次政府紓困方案會不會太大方」

D-3-6 主題分布

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.

畫出topic的分布，可看出大部分的文章出自於八卦版，政黑板次之。 topic1:台灣疫情與國際關係 topic2:紓困補助方案 topic3:疫情紓困預算案 topic4:紓困政策規劃

D-4 社群網路圖

資料合併

# 文章和留言
reviews <- reviews %>%
      select(artUrl, cmtPoster, cmtStatus, cmtContent)
posts_Reviews <- merge(x = metadata, y = reviews, by = "artUrl")

# 把文章和topic
posts_Reviews <- merge(x = posts_Reviews, y = vaccine_topics, by.x = "artUrl", by.y="document")
head(posts_Reviews,3)
##                                                      artUrl
## 1: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html
## 2: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html
## 3: https://www.ptt.cc/bbs/Gossiping/M.1619875736.A.640.html
##                                artTitle    artDate  artTime  artPoster
## 1: [新聞]蔡英文盤點政策：加薪減稅挺勞工 2021/05/01 13:28:51 borondawon
## 2: [新聞]蔡英文盤點政策：加薪減稅挺勞工 2021/05/01 13:28:51 borondawon
## 3: [新聞]蔡英文盤點政策：加薪減稅挺勞工 2021/05/01 13:28:51 borondawon
##       artCat commentNum push boo
## 1: Gossiping        210   24 105
## 2: Gossiping        210   24 105
## 3: Gossiping        210   24 105
##                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      sentence
## 1: 蔡英文盤點政策：加薪減稅挺勞工　全民共享經濟果實\n\n蘋果新聞網  林麒瑋、周彥妤／台北報導\n1小時前\n\n五一勞動節，蔡英文盤點勞工政策。翻攝蔡英文臉書\n\n\n今（1日）是五一勞動節，總統蔡英文盤點各項勞工政策，包含法案的通過、法制的進展，以及相關的加薪、減稅等。行政院長蘇貞昌則強調，台灣經濟成長率今年第一季8.16％，創下近10年來單季新高，強調政府會繼續拚經濟，並透過減稅、增加育兒津貼、健全社會福利，讓民眾一起享受經濟成長的果實。\n\n\n蔡英文在臉書發文指出，勞工支撐起台灣的經濟，這幾年來，政府也完善法制、加薪減稅，努力挺勞工。包含通過《勞工職業災害保險及保護法》，整合各類職災補償制度，將可以打造更完整的職業災害保障體系。\n\n蔡英文表示，政府也陸續完成《勞動事件法》及《中高齡者及高齡者就業促進法》的立法，也修法保障派遣勞工的權益。加薪、基本工資連續5年調升，22K正式走入歷史，此外也鼓勵企業加薪。最後，減稅，提高所得稅四大標準扣除額後，今年不課稅的每人基本生活費也調高7000元，調幅是歷年最高，希望能減輕勞工的負擔。\n\n\n蔡英文表示，台灣經濟的基本面不錯，今年第一季經濟成長率概估值更是超過8％，創下10年來單季新高。這些成長的果實，都應該多回饋給辛苦的勞工朋友。\n\n蔡英文也提醒，拚經濟的前提是維持著防疫表現，面對疫情變化，不能掉以輕心。假期間如果有出門，一定要戴好口罩、落實防疫措施。\n\n蘇貞昌強調今年第一季經濟成長率8.16％，是十年來的單季新高。翻攝蘇貞昌臉書\n\n蘇貞昌也指出，今年第一季的經濟成長率8.16％，這是10年來的單季新高。台灣在百年大疫的威脅下撐過去，經濟越挫越勇，去年台灣的經濟成長3.11％，領先所有已開發國家，許多外銀都預測台灣今年全年成長率會高達5％，這是全民響應防疫、國際大廠投資台灣、辛苦打拚的成果。蘇貞昌強調，政府會繼續為大家拚經濟，也會透過減稅、增加育兒津貼、健全社會福利，讓大家一起享受經濟成長的果實。\n\n\n民進黨發言人顏若芳表示，在屬於勞動者的日子裡，感謝、肯定每位勞工朋友，對台灣經濟與社會的貢獻；民進黨一直以來都與勞工朋友站在一起，關心勞工處境，注重勞工權益。\n\n她指出，勞動節前夕，政府兌現《勞工職業災害保險及保護法》單獨立法的承諾；5年來，民進黨政府持續透過勞動政策與立法，致力提高薪資、促進就業，完善勞動體制。\n\n顏若芳也舉例，保障勞工基本生活水準，蔡政府年年提高基本工資，月薪從20008元調高到24000元，時薪從120元調高到160元，相較國民黨執政的漲幅15.8%及26.3%，蔡英文執政5年漲幅已近20%及33%，不管月薪及時薪的調整，民進黨執政5年，都比國民黨8年還高，更打破前總統馬英九制定月薪22K的低薪魔咒。\n\n她也說，民進黨政府未來也會綜合考量社會經濟情勢，讓勞工薪資更符社會期待水準；年金保障上，廣泛蒐整意見，持續與社會溝通，絕對是首要之務，政府絕對會負起最終的給付責任。\nhttps://tw.appledaily.com/politics/20210501/OWUZDBFOFVF2VLW5OPH5UOZQZA/\n感謝小英  讚嘆小英\n\n我看有超多勞工都在臉書感謝總統  真的很有感！\n\n台灣勞工真的賺大錢了！\n\n投給蔡英文  真的投對了！\n\n\n\n
## 2: 蔡英文盤點政策：加薪減稅挺勞工　全民共享經濟果實\n\n蘋果新聞網  林麒瑋、周彥妤／台北報導\n1小時前\n\n五一勞動節，蔡英文盤點勞工政策。翻攝蔡英文臉書\n\n\n今（1日）是五一勞動節，總統蔡英文盤點各項勞工政策，包含法案的通過、法制的進展，以及相關的加薪、減稅等。行政院長蘇貞昌則強調，台灣經濟成長率今年第一季8.16％，創下近10年來單季新高，強調政府會繼續拚經濟，並透過減稅、增加育兒津貼、健全社會福利，讓民眾一起享受經濟成長的果實。\n\n\n蔡英文在臉書發文指出，勞工支撐起台灣的經濟，這幾年來，政府也完善法制、加薪減稅，努力挺勞工。包含通過《勞工職業災害保險及保護法》，整合各類職災補償制度，將可以打造更完整的職業災害保障體系。\n\n蔡英文表示，政府也陸續完成《勞動事件法》及《中高齡者及高齡者就業促進法》的立法，也修法保障派遣勞工的權益。加薪、基本工資連續5年調升，22K正式走入歷史，此外也鼓勵企業加薪。最後，減稅，提高所得稅四大標準扣除額後，今年不課稅的每人基本生活費也調高7000元，調幅是歷年最高，希望能減輕勞工的負擔。\n\n\n蔡英文表示，台灣經濟的基本面不錯，今年第一季經濟成長率概估值更是超過8％，創下10年來單季新高。這些成長的果實，都應該多回饋給辛苦的勞工朋友。\n\n蔡英文也提醒，拚經濟的前提是維持著防疫表現，面對疫情變化，不能掉以輕心。假期間如果有出門，一定要戴好口罩、落實防疫措施。\n\n蘇貞昌強調今年第一季經濟成長率8.16％，是十年來的單季新高。翻攝蘇貞昌臉書\n\n蘇貞昌也指出，今年第一季的經濟成長率8.16％，這是10年來的單季新高。台灣在百年大疫的威脅下撐過去，經濟越挫越勇，去年台灣的經濟成長3.11％，領先所有已開發國家，許多外銀都預測台灣今年全年成長率會高達5％，這是全民響應防疫、國際大廠投資台灣、辛苦打拚的成果。蘇貞昌強調，政府會繼續為大家拚經濟，也會透過減稅、增加育兒津貼、健全社會福利，讓大家一起享受經濟成長的果實。\n\n\n民進黨發言人顏若芳表示，在屬於勞動者的日子裡，感謝、肯定每位勞工朋友，對台灣經濟與社會的貢獻；民進黨一直以來都與勞工朋友站在一起，關心勞工處境，注重勞工權益。\n\n她指出，勞動節前夕，政府兌現《勞工職業災害保險及保護法》單獨立法的承諾；5年來，民進黨政府持續透過勞動政策與立法，致力提高薪資、促進就業，完善勞動體制。\n\n顏若芳也舉例，保障勞工基本生活水準，蔡政府年年提高基本工資，月薪從20008元調高到24000元，時薪從120元調高到160元，相較國民黨執政的漲幅15.8%及26.3%，蔡英文執政5年漲幅已近20%及33%，不管月薪及時薪的調整，民進黨執政5年，都比國民黨8年還高，更打破前總統馬英九制定月薪22K的低薪魔咒。\n\n她也說，民進黨政府未來也會綜合考量社會經濟情勢，讓勞工薪資更符社會期待水準；年金保障上，廣泛蒐整意見，持續與社會溝通，絕對是首要之務，政府絕對會負起最終的給付責任。\nhttps://tw.appledaily.com/politics/20210501/OWUZDBFOFVF2VLW5OPH5UOZQZA/\n感謝小英  讚嘆小英\n\n我看有超多勞工都在臉書感謝總統  真的很有感！\n\n台灣勞工真的賺大錢了！\n\n投給蔡英文  真的投對了！\n\n\n\n
## 3: 蔡英文盤點政策：加薪減稅挺勞工　全民共享經濟果實\n\n蘋果新聞網  林麒瑋、周彥妤／台北報導\n1小時前\n\n五一勞動節，蔡英文盤點勞工政策。翻攝蔡英文臉書\n\n\n今（1日）是五一勞動節，總統蔡英文盤點各項勞工政策，包含法案的通過、法制的進展，以及相關的加薪、減稅等。行政院長蘇貞昌則強調，台灣經濟成長率今年第一季8.16％，創下近10年來單季新高，強調政府會繼續拚經濟，並透過減稅、增加育兒津貼、健全社會福利，讓民眾一起享受經濟成長的果實。\n\n\n蔡英文在臉書發文指出，勞工支撐起台灣的經濟，這幾年來，政府也完善法制、加薪減稅，努力挺勞工。包含通過《勞工職業災害保險及保護法》，整合各類職災補償制度，將可以打造更完整的職業災害保障體系。\n\n蔡英文表示，政府也陸續完成《勞動事件法》及《中高齡者及高齡者就業促進法》的立法，也修法保障派遣勞工的權益。加薪、基本工資連續5年調升，22K正式走入歷史，此外也鼓勵企業加薪。最後，減稅，提高所得稅四大標準扣除額後，今年不課稅的每人基本生活費也調高7000元，調幅是歷年最高，希望能減輕勞工的負擔。\n\n\n蔡英文表示，台灣經濟的基本面不錯，今年第一季經濟成長率概估值更是超過8％，創下10年來單季新高。這些成長的果實，都應該多回饋給辛苦的勞工朋友。\n\n蔡英文也提醒，拚經濟的前提是維持著防疫表現，面對疫情變化，不能掉以輕心。假期間如果有出門，一定要戴好口罩、落實防疫措施。\n\n蘇貞昌強調今年第一季經濟成長率8.16％，是十年來的單季新高。翻攝蘇貞昌臉書\n\n蘇貞昌也指出，今年第一季的經濟成長率8.16％，這是10年來的單季新高。台灣在百年大疫的威脅下撐過去，經濟越挫越勇，去年台灣的經濟成長3.11％，領先所有已開發國家，許多外銀都預測台灣今年全年成長率會高達5％，這是全民響應防疫、國際大廠投資台灣、辛苦打拚的成果。蘇貞昌強調，政府會繼續為大家拚經濟，也會透過減稅、增加育兒津貼、健全社會福利，讓大家一起享受經濟成長的果實。\n\n\n民進黨發言人顏若芳表示，在屬於勞動者的日子裡，感謝、肯定每位勞工朋友，對台灣經濟與社會的貢獻；民進黨一直以來都與勞工朋友站在一起，關心勞工處境，注重勞工權益。\n\n她指出，勞動節前夕，政府兌現《勞工職業災害保險及保護法》單獨立法的承諾；5年來，民進黨政府持續透過勞動政策與立法，致力提高薪資、促進就業，完善勞動體制。\n\n顏若芳也舉例，保障勞工基本生活水準，蔡政府年年提高基本工資，月薪從20008元調高到24000元，時薪從120元調高到160元，相較國民黨執政的漲幅15.8%及26.3%，蔡英文執政5年漲幅已近20%及33%，不管月薪及時薪的調整，民進黨執政5年，都比國民黨8年還高，更打破前總統馬英九制定月薪22K的低薪魔咒。\n\n她也說，民進黨政府未來也會綜合考量社會經濟情勢，讓勞工薪資更符社會期待水準；年金保障上，廣泛蒐整意見，持續與社會溝通，絕對是首要之務，政府絕對會負起最終的給付責任。\nhttps://tw.appledaily.com/politics/20210501/OWUZDBFOFVF2VLW5OPH5UOZQZA/\n感謝小英  讚嘆小英\n\n我看有超多勞工都在臉書感謝總統  真的很有感！\n\n台灣勞工真的賺大錢了！\n\n投給蔡英文  真的投對了！\n\n\n\n
##      cmtPoster cmtStatus            cmtContent topic     gamma
## 1:       hy654         →     :borondawon祝刑安     4 0.6931818
## 2: fckj1131017         → :自立自強母豬去吃屎啦     4 0.6931818
## 3:      gankgf         →               :好感動     4 0.6931818

資料篩選

資料篩選的方式：

  • 文章:文章日期、留言數(commentNum)
  • link、node:degree

大部分文章留言數<100

# 看一下留言數大概都多少
metadata %>%
  filter(commentNum<300) %>%
  ggplot(aes(x=commentNum)) + geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

# 檢視參與人數
length(unique(posts_Reviews$artPoster)) # 發文者數量 703
## [1] 703
length(unique(posts_Reviews$cmtPoster)) # 回覆者數量 13375
## [1] 13375
allPoster <- c(posts_Reviews$artPoster, posts_Reviews$cmtPoster) # 總參與人數 13745
length(unique(allPoster))
## [1] 13745

標記所有出現過得使用者

  • poster：只發過文、發過文+留過言
  • replyer：只留過言
userList <- data.frame(user=unique(allPoster)) %>%
              mutate(type=ifelse(user%in%metadata$artPoster, "poster", "replyer"))
head(userList,3)
##         user   type
## 1 borondawon poster
## 2 bigDwinsch poster
## 3    qqq5566 poster

D-4-1 以主題篩選社群

  • 抓link

挑選出2021-05-27與2021-06-04當天的文章， 篩選一篇文章回覆3次以上者，且文章留言數多餘30則， 文章主題歸類為2(紓困主題方案)與4(紓困政策規劃)者， 欄位只取：cmtPoster(評論者), artPoster(發文者), artUrl(文章連結), topic(主題)

  • 5/27 ，國發會於行政院院會陳報紓困4.0方案
link1 <- posts_Reviews %>%
      group_by(cmtPoster, artUrl) %>% 
      filter(n()>3) %>% 
      filter(commentNum > 30) %>%
      filter(artDate == as.Date('2021-05-27')) %>%
      filter(topic == 2 | topic == 4) %>%
      select(cmtPoster, artPoster, artUrl,topic) %>% 
      unique()
link1
## # A tibble: 79 x 4
## # Groups:   cmtPoster, artUrl [79]
##    cmtPoster   artPoster artUrl                                            topic
##    <chr>       <chr>     <chr>                                             <int>
##  1 cisyong     new1974   https://www.ptt.cc/bbs/Gossiping/M.1622074032.A.~     4
##  2 massageking DoraGmon  https://www.ptt.cc/bbs/Gossiping/M.1622078691.A.~     2
##  3 looks143895 DoraGmon  https://www.ptt.cc/bbs/Gossiping/M.1622078691.A.~     2
##  4 sellgd      DoraGmon  https://www.ptt.cc/bbs/Gossiping/M.1622078691.A.~     2
##  5 fulongb210f DoraGmon  https://www.ptt.cc/bbs/Gossiping/M.1622078691.A.~     2
##  6 tony20095   DoraGmon  https://www.ptt.cc/bbs/Gossiping/M.1622078691.A.~     2
##  7 color3258   DoraGmon  https://www.ptt.cc/bbs/Gossiping/M.1622078691.A.~     2
##  8 piliwu      KrisNYC   https://www.ptt.cc/bbs/Gossiping/M.1622080252.A.~     4
##  9 falex       KrisNYC   https://www.ptt.cc/bbs/Gossiping/M.1622080252.A.~     4
## 10 fatetree    KrisNYC   https://www.ptt.cc/bbs/Gossiping/M.1622080252.A.~     4
## # ... with 69 more rows

篩選在link裡面有出現的使用者

#2021/5/27
filtered_user1 <- userList %>%
          filter(user%in%link1$cmtPoster | user%in%link1$artPoster) %>%
          arrange(desc(type))
head(filtered_user1,3)
##           user    type
## 1      cisyong replyer
## 2 AustinRivers replyer
## 3   puritylife replyer
  • 6/4 ，行政院通過紓困特別預算案4.0並啟動紓困4.0
#2021-06-04
link2 <- posts_Reviews %>%
      group_by(cmtPoster, artUrl) %>% 
      filter(n()>3) %>% 
      filter(commentNum > 30) %>%
      filter(artDate == as.Date('2021-06-04')) %>%
      filter(topic == 2 | topic == 4) %>% 
      select(cmtPoster, artPoster, artUrl, topic) %>% 
      unique()
link2
## # A tibble: 36 x 4
## # Groups:   cmtPoster, artUrl [36]
##    cmtPoster    artPoster   artUrl                                         topic
##    <chr>        <chr>       <chr>                                          <int>
##  1 kcclasaki    InfocusM510 https://www.ptt.cc/bbs/Gossiping/M.1622765981~     4
##  2 popy8789     InfocusM510 https://www.ptt.cc/bbs/Gossiping/M.1622765981~     4
##  3 gest7240     InfocusM510 https://www.ptt.cc/bbs/Gossiping/M.1622765981~     4
##  4 ptt987654321 kirorolove  https://www.ptt.cc/bbs/Gossiping/M.1622770320~     4
##  5 kirorolove   kirorolove  https://www.ptt.cc/bbs/Gossiping/M.1622770320~     4
##  6 jokerming847 kirorolove  https://www.ptt.cc/bbs/Gossiping/M.1622770320~     4
##  7 jokerming847 zakijudelo  https://www.ptt.cc/bbs/Gossiping/M.1622771453~     4
##  8 TonyQ        rainy7799   https://www.ptt.cc/bbs/Gossiping/M.1622781486~     4
##  9 kkevinhess1t TRFgee      https://www.ptt.cc/bbs/Gossiping/M.1622791336~     4
## 10 eko112       spidina     https://www.ptt.cc/bbs/Gossiping/M.1622797386~     2
## # ... with 26 more rows

篩選在link裡面有出現的使用者

#2021-06-04
filtered_user2 <- userList %>%
          filter(user%in%link2$cmtPoster | user%in%link2$artPoster) %>%
          arrange(desc(type))
head(filtered_user2,3)
##        user    type
## 1    labell replyer
## 2  doro0202 replyer
## 3 kcclasaki replyer

D-4-2 使用者經常參與的文章種類

#2021-5-27
filter_degree = 3 # 使用者degree

# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link1, v=filtered_user1, 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>5的才畫出來)
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"), lty=1, cex=1)

highperpopo大多發布紓困政策規劃文章，例如:「為啥小黃補助都是無條件」

allenmusic大多發布紓困主題方案文章，例如:「政院紓困開倉濟眾 個人補貼最高3萬元」

AmaniTsubasay則是兩類文章皆有發布，例如:「政院推紓困4.0 蘇貞昌：擬員工薪資補貼」、「為什麼發現金紓困那麼難?」

#2021-06-04
filter_degree = 3 # 使用者degree

# 建立網路關係
reviewNetwork1 <- graph_from_data_frame(d=link2, v=filtered_user2, directed=F)

# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork1)
V(reviewNetwork1)$label <- names(labels)
V(reviewNetwork1)$color <- ifelse(V(reviewNetwork1)$type=="poster", "gold", "lightblue")

# 依據回覆發生的文章所對應的主題，對他們的關聯線進行上色
E(reviewNetwork1)$color <- ifelse(E(reviewNetwork1)$topic == "2", "palevioletred", "lightgreen")

# 畫出社群網路圖(degree>5的才畫出來)
set.seed(5432)
plot(reviewNetwork1, vertex.size=3, edge.width=3, vertex.label.dist=1,
     vertex.label=ifelse(degree(reviewNetwork1) > filter_degree, V(reviewNetwork1)$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"), lty=1, cex=1)

bighaohao大多發布紓困政策規劃文章，例如:「紓困4.0？有排富嗎？」

abin0818大多發布紓困政策規劃文章，例如:「為何紓困就一定要加入職業工會才能領?」

D-4-3 使用者是否受到歡迎

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

filter_degree = 3 # 使用者degree

# 過濾留言者對發文者的推噓程度
link <- posts_Reviews %>%
      filter(cmtStatus!="→") %>%
      group_by(cmtPoster, artUrl) %>%
      filter(commentNum > 70) %>%
      filter( n() > 2) %>%
      ungroup() %>% 
      select(cmtPoster, artPoster, artUrl, cmtStatus) %>% 
      unique()

# 接下來把網路圖畫出來，跟前面做的事都一樣，因此不再細述

# 篩選link中有出現的使用者
filtered_user3 <- userList %>%
          filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
          arrange(desc(type))

# 建立網路關係
reviewNetwork3 <- graph_from_data_frame(d=link, v=filtered_user3, directed=F)

# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork3)
V(reviewNetwork3)$label <- names(labels)
V(reviewNetwork3)$color <- ifelse(V(reviewNetwork3)$type=="poster", "gold", "lightblue")


# 依據回覆發生的文章所對應的主題，對他們的關聯線進行上色
E(reviewNetwork3)$color <- ifelse(E(reviewNetwork3)$cmtStatus == "推", "lightgreen", "palevioletred")

# 畫出社群網路圖
set.seed(5432)
plot(reviewNetwork3, vertex.size=2, edge.width=3, vertex.label.dist=1,
     vertex.label=ifelse(degree(reviewNetwork3) > filter_degree, V(reviewNetwork3)$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)

可以發現本次的討論中幾乎都是推文、噓文較少

E. 結論

  1. 政府紓困政策的討論重點有哪些? 主要分為哪幾種風向?
    對於2021-05-01 ~ 2021-06-08收集的文章，大概可以分成嘲諷紓困政策、客觀討論紓困政策這兩種，其他還有著重討論台灣疫情與國際形勢或和紓困預算相關的討論等四種。討論重點多在於統計「方針」、「公布日期」。
  1. 目前風向最偏哪邊?
    選定5/27，5/29，6/3，6/6這四天，對推噓文進行情緒分析，儘管客觀討論計算方式的文章不少，但嘲諷、八卦性質的文章居多，也判斷出大部分網友對紓困4.0政策與中央政府規劃，抱持著負面的態度。
  1. 討論紓困政策的社群網路如何分布?
    社群聲量高的網友以嘲諷政府紓困政策規劃居多，對於中央態度、預算編列多以批評嘲諷為主 以社群文章數來看，批評嘲諷的網友較多，但從社群網路觀察發現，兩邊的貼文討論聲量都很高。