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"

1. 套件取得及資料載入

套件載入

library(readr)
library(data.table)
library(ggplot2)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:data.table':
## 
##     between, first, last

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(jiebaR)

## Loading required package: jiebaRD

library(tidyr)
library(tidytext)
library(stringr)
library(tm)

## Loading required package: NLP

## 
## Attaching package: 'NLP'

## The following object is masked from 'package:ggplot2':
## 
##     annotate

library(topicmodels)
library(purrr)

## 
## Attaching package: 'purrr'

## The following object is masked from 'package:data.table':
## 
##     transpose

library(igraph)

## 
## Attaching package: 'igraph'

## The following objects are masked from 'package:purrr':
## 
##     compose, simplify

## The following object is masked from 'package:tidyr':
## 
##     crossing

## The following objects are masked from 'package:dplyr':
## 
##     as_data_frame, groups, union

## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum

## The following object is masked from 'package:base':
## 
##     union

require(RColorBrewer)

## Loading required package: RColorBrewer

library(reshape2)

## 
## Attaching package: 'reshape2'

## The following object is masked from 'package:tidyr':
## 
##     smiths

## The following objects are masked from 'package:data.table':
## 
##     dcast, melt

library(wordcloud2)
library(widyr)
library(ggraph)

資料描述

資料來源: 文字平台收集PTT Gossip、MRT、台中版 2020-05-01 ~ 2021-05-15 所有文章與留言
資料集： yen_mrt1_articleMetaData.csv 、yen_mrt2_articleMetaData.csv 、yen_mrt3_articleMetaData.csv
關鍵字：台中捷運、中捷
資料時間：2020-05-01 ~ 2021-05-15
文章篇數：總共 480 篇

# 將三個版的資料合併
MetaData1 = fread('yen_mrt1_articleMetaData.csv',encoding = 'UTF-8')
MetaData2 = fread('yen_mrt2_articleMetaData.csv',encoding = 'UTF-8')
MetaData3 = fread('yen_mrt3_articleMetaData.csv',encoding = 'UTF-8')
Reviews1  = fread('yen_mrt1_articleReviews.csv',encoding = 'UTF-8')
Reviews2  = fread('yen_mrt2_articleReviews.csv',encoding = 'UTF-8')
Reviews3  = fread('yen_mrt3_articleReviews.csv',encoding = 'UTF-8')

MetaData = rbind(MetaData1, MetaData2, MetaData3)
Reviews  = rbind(Reviews1, Reviews2, Reviews3)

# 再篩一次文章 480 篇
keywords = c('台中捷運', '中捷')
toMatch = paste(keywords,collapse="|")
MetaData = with(MetaData, MetaData[grepl(toMatch,sentence)|grepl(toMatch,artTitle),])

# 挑選文章對應的留言 28945 則留言
Reviews = left_join(MetaData, Reviews[,c("artUrl", "cmtPoster", "cmtStatus", "cmtContent")], by = "artUrl")

head(MetaData)

##                                                artTitle    artDate  artTime
## 1:           [新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 01:29:09
## 2:        Re:[新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 02:23:26
## 3:        Re:[新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 03:17:33
## 4:        Re:[新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 05:16:30
## 5:           [新聞]中捷橘線要等生孫子才坐得到？交通局： 2020/05/04 08:58:16
## 6: [新聞]中捷比照北高20元起跳　議員預言：難逃虧損命運！ 2020/05/09 02:18:52
##                                                      artUrl    artPoster
## 1: https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html    redhill86
## 2: https://www.ptt.cc/bbs/Gossiping/M.1588559009.A.670.html       dingwk
## 3: https://www.ptt.cc/bbs/Gossiping/M.1588562255.A.77E.html ComeAsYouAre
## 4: https://www.ptt.cc/bbs/Gossiping/M.1588569392.A.358.html      CNS3056
## 5: https://www.ptt.cc/bbs/Gossiping/M.1588582698.A.3E5.html      Minekun
## 6: https://www.ptt.cc/bbs/Gossiping/M.1588990735.A.4C6.html       f14mp5
##       artCat commentNum push boo
## 1: Gossiping        326  135  28
## 2: Gossiping         16    6   0
## 3: Gossiping         18    6   1
## 4: Gossiping          9    5   0
## 5: Gossiping         82   48   7
## 6: Gossiping         55   25   6
##                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         sentence
## 1:                                                                                                                                                                                             1.媒體來源:\n自由時報\n\n2.記者署名：\n唐在馨\n\n3.完整新聞標題:\n大變革？台中捷運橘線規劃改部份地下化\n\n4.完整新聞內文：\n\n〔記者唐在馨／台中報導〕台中捷運文心線預計今年底會正式營運，市府同步也在進行藍線及橘線的規劃，據指出，「盧秀燕版」的捷運橘線將重新規劃部份地下化的的可行性，而這是否造成預算規模及推動時程的增加？交通局長葉昭甫表示「待評估」。\n\n據指出，台中捷運橘線是前市長胡志強時代開始推動，主要路線是中清路（過去的大雅路），串連清泉崗機場到火車站，但到前市長林佳龍時代則改推雙港輕軌，路線串連清泉崗及台中港之外，也朝路面上輕軌捷運為主。\n\n不過，市長盧秀燕上任後，目前捷運橘線正在做可行性規劃，交通局長葉昭甫說，因為前面二任市長的路線有做一些更動，目前市府也針對優缺點做評估，主路線不變，但應該不會做輕軌，而也會出現和捷運藍線一樣，「部份地下化」的變化。\n\n葉昭甫說，捷運藍線的規劃目前是從台中火車站到東海大學都是以地下化為主，而橘線的地下化部份，目前也是以原台中市區的方向為主，而目前發展中的水湳經貿園區，也會有橘線通過，此段會以地下化為主。\n\n葉昭甫說，其實如果以地下化來說，經費及工期都不是太大的問題，但是因為捷運綠線是高架，屆時橘線如果有部份地下，將和藍線一樣，高架及地下捷運的車站共構的技術問題，屆時將會是研究的重點。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3153964?utm_medium=P\n6.備註:\n        可不依內建發文格式填寫，但一定要有1~5項，若要加上心得或備註，請於文章最後面加上。\n\n市中心向外延伸應該都要地下化。\n
## 2:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                      捷運，高架 或者 地下化 其實都有利有弊啦\n\n這邊簡單說一下：\n地下化的成本還有工期 當然會拉得比較長\n可是想想捷運這種東西不就是蓋了不能後悔嗎XDD\n我們來看看目前走高架的捷運 或者 交通設施\n天龍國的文湖線 之前就被說品質不佳\n再到桃園捷運...那個就點到為止了吧\n所以單就這樣來看，我覺得地下化不錯啊\n看看天龍國的捷運，多數也都走地下化\n\n再者，目前台中已經成為台灣的第二大都市\n人口啦、建設啦，市區很塞同時也不好停車\n多點大眾交通設施對整體的發展也是不錯的\n\n台中捷運綠線，在今年(2020年)\n盧秀燕開出了支票，拜託 經歷前兩任市長的跳票\n如果這張支票在不兌現，別說連任 應該會直接引起我大台中市民的眾怒\n這樣來說應該是沒什麼問題啦？\n\n以前中央不管藍綠，都沒有看好台中\n但誰也沒想到大台北地區這麼迅速就飽和且停滯(?\n台中現在的發展還比桃園要來得快 齁齁\n你各位怎麼看？\n
## 3:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  藍線連個鳥都沒有，還在橘線\n人家桃園扣掉機捷，另外一條綠線開始動工了\n\n媽的台中捷運除了為了連高鐵而建的綠線\n其他線路講20年都還在紙上作業\n\n快笑死了\n第二大城\n幹，黑道跟地下經濟的故鄉吧
## 4:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             幾張圖回顧一台中捷運規劃的歷史\n\n\n遠古時期 1990s\n\n民國87年細部規劃110年路網\nhttps://imgur.com/2ijG50r.jpg\n胡志強時期 2001-2014\n\n2009.04 第一次出現橘線，核心路網為水湳經貿園區至霧峰，全線設十七座車站\nhttps://imgur.com/vaUfrWp.jpg\n2012.08\n\n內含做到半套的BRT ，來源是2011年7月，臺中市政府建立臺中市快捷巴士計畫，將公車捷運系統作為藍線、橘線的前\n期試辦，以及運量之培養。8月20日，交通部核定快捷巴士BRT藍線（優先路段），\n並補助新臺幣6500萬元設計監造費。\nhttps://i.imgur.com/fIhbQqV.png\n林佳龍時期 2014-2018\n\n2014年8月19日，臺中市交通局將可行性研究報告陳報交通部審查；交通部於10月7日回覆\n審查意見，表示現規劃的BRT是與橘線路廊重疊，具有競合關係，請市府釐清並依作業程\n序規定，提出臺中都會區都市發展規劃及公共運輸發展計畫，以及捷運路線興建之優先順\n序\n\n2015.02 佳龍大改版之輕軌+山手線\nhttps://i.imgur.com/p8Uuu1j.jpg\n2018.01 執政後期\nhttps://imgur.com/vTDdpKN.jpg\n2018.12\nhttps://imgur.com/KAyduah.jpg\n盧秀燕時期 2018-?\n\n2019.03 橘線雙港輕軌改回機場捷運\nhttps://i.imgur.com/uJSvQvb.jpg\nhttps://imgur.com/vZjdHlv.jpg\n十年後再看看吧\n\n
## 5:                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  1.媒體來源:\n自由時報（請參考版規下方的核准媒體名單）\n\n\n2.記者署名:\n唐在馨\n\n3.完整新聞標題:\n中捷橘線要等生孫子才坐得到？ 交通局：再等20年就好\n\n4.完整新聞內文:\n台中捷運綠線預計年底通車，本報今天獨家報導橘線將改部份地下化，引來不少軌道迷討\n論，有人質疑，以台中捷運路網的推進時程，如果再改成部份地下化，」可等要等到孫子\n生了才坐的到」。\n\n對此，交通局長葉昭甫表示，「沒有開始，怎有結束」？一切建設都要先有開始，否則無\n法斷言何時完成，至於橘線要何時完成？是否真的要等到網友或民眾所言：「要等到孫子\n生了讓孫子坐」？葉昭甫則說，「應該不用等那麼久」。\n\n他表示，依照台中捷運綠線及藍線推動時程估算，以藍線從102年左右開始進行評估到現\n在估算120年可以完成，所以一條捷運從評估到施作完成，保守估計是15年到20年之內可\n以完成，目前橘線已經開始進行評估作業，樂觀估算，「應該不用等到孫子出生」，20年\n內可以完成。\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3154429\n6.備註:
## 6: http://www.taiwanhot.net/?p=819337\n＜中捷比照北高20元起跳　議員預言：難逃虧損命運！＞\n\n記者黃志政／台中報導\n台灣好新聞2020-05-07 17:41\n台中捷運綠線通車在即，市民相當關心台中捷運公司通車後的營運規劃。市議員陳文政表\n示，中捷票價擬20元起，可能導致捷運通車後連年虧損。陳文政整理2018北捷、高捷、桃\n捷的財務報表，發現票價30元起跳的桃捷，在通車第二年起本業就開始賺錢，達到損益兩\n平；而北捷、高捷通車以來票價都20元起，至今本業仍年損超過10億，等同運量越高賠越\n多。中捷票價如20元起跳，恐難逃連年虧損的命運。\n\n市議會7日進行專案報告議程，市議員陳文政對台中捷運票價20元起跳提出質疑。他表示\n他山之石可以攻錯，特別整理了2018年台北、桃園、高雄捷運公司的財務報表，將「運輸\n收入」減去「營業成本＋營業費用」，探討捷運能否靠運輸本業達到損益兩平。\n\n陳文政指出，票價20元起的北高捷運，就算通車多年運量已經趨近穩定，光靠運輸本業北\n捷仍年損25億，高捷仍年損接近10億。而票價30元起跳的桃園捷運，卻在2018通車第2年\n後，光靠運輸收入已經能損益兩平。中捷20元起跳的票價等同北高捷運，陳文政相當憂慮\n中捷通車後，如失速列車一樣，發生連年虧損的慘況。\n\n陳文政表示，桃捷開始盈利後就得意忘形，為了選舉考量又調成20元起，後續將開始虧損\n已經可以預期。捷運票價「調降容易漲價難」，中捷票價水準竟然等同10年前的高捷、30\n年前的台北捷運，沒有考量這20年來物價與人力成本的上漲。中捷若不調整票價，本業慘\n賠已經是可以預期的事。\n\n最後陳文政也建議，不要害怕票價高沒人搭，前期可以結合「i-bike」「停車費」「市公\n車」甚至「高鐵」的轉乘優惠，還是能有效提升運量，達到運輸本業損益兩平的目標。同\n時也提醒交通局，須盡快調整與捷運路線重疊超過3站的公車路線，避免發生公車與捷運\n搶「短程旅客」的窘境。\n\n

head(Reviews)

##                                      artTitle    artDate  artTime
## 1: [新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 01:29:09
## 2: [新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 01:29:09
## 3: [新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 01:29:09
## 4: [新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 01:29:09
## 5: [新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 01:29:09
## 6: [新聞]大變革？台中捷運橘線規劃改部份地下化 2020/05/04 01:29:09
##                                                      artUrl artPoster    artCat
## 1: https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html redhill86 Gossiping
## 2: https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html redhill86 Gossiping
## 3: https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html redhill86 Gossiping
## 4: https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html redhill86 Gossiping
## 5: https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html redhill86 Gossiping
## 6: https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html redhill86 Gossiping
##    commentNum push boo
## 1:        326  135  28
## 2:        326  135  28
## 3:        326  135  28
## 4:        326  135  28
## 5:        326  135  28
## 6:        326  135  28
##                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                             sentence
## 1: 1.媒體來源:\n自由時報\n\n2.記者署名：\n唐在馨\n\n3.完整新聞標題:\n大變革？台中捷運橘線規劃改部份地下化\n\n4.完整新聞內文：\n\n〔記者唐在馨／台中報導〕台中捷運文心線預計今年底會正式營運，市府同步也在進行藍線及橘線的規劃，據指出，「盧秀燕版」的捷運橘線將重新規劃部份地下化的的可行性，而這是否造成預算規模及推動時程的增加？交通局長葉昭甫表示「待評估」。\n\n據指出，台中捷運橘線是前市長胡志強時代開始推動，主要路線是中清路（過去的大雅路），串連清泉崗機場到火車站，但到前市長林佳龍時代則改推雙港輕軌，路線串連清泉崗及台中港之外，也朝路面上輕軌捷運為主。\n\n不過，市長盧秀燕上任後，目前捷運橘線正在做可行性規劃，交通局長葉昭甫說，因為前面二任市長的路線有做一些更動，目前市府也針對優缺點做評估，主路線不變，但應該不會做輕軌，而也會出現和捷運藍線一樣，「部份地下化」的變化。\n\n葉昭甫說，捷運藍線的規劃目前是從台中火車站到東海大學都是以地下化為主，而橘線的地下化部份，目前也是以原台中市區的方向為主，而目前發展中的水湳經貿園區，也會有橘線通過，此段會以地下化為主。\n\n葉昭甫說，其實如果以地下化來說，經費及工期都不是太大的問題，但是因為捷運綠線是高架，屆時橘線如果有部份地下，將和藍線一樣，高架及地下捷運的車站共構的技術問題，屆時將會是研究的重點。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3153964?utm_medium=P\n6.備註:\n        可不依內建發文格式填寫，但一定要有1~5項，若要加上心得或備註，請於文章最後面加上。\n\n市中心向外延伸應該都要地下化。\n
## 2: 1.媒體來源:\n自由時報\n\n2.記者署名：\n唐在馨\n\n3.完整新聞標題:\n大變革？台中捷運橘線規劃改部份地下化\n\n4.完整新聞內文：\n\n〔記者唐在馨／台中報導〕台中捷運文心線預計今年底會正式營運，市府同步也在進行藍線及橘線的規劃，據指出，「盧秀燕版」的捷運橘線將重新規劃部份地下化的的可行性，而這是否造成預算規模及推動時程的增加？交通局長葉昭甫表示「待評估」。\n\n據指出，台中捷運橘線是前市長胡志強時代開始推動，主要路線是中清路（過去的大雅路），串連清泉崗機場到火車站，但到前市長林佳龍時代則改推雙港輕軌，路線串連清泉崗及台中港之外，也朝路面上輕軌捷運為主。\n\n不過，市長盧秀燕上任後，目前捷運橘線正在做可行性規劃，交通局長葉昭甫說，因為前面二任市長的路線有做一些更動，目前市府也針對優缺點做評估，主路線不變，但應該不會做輕軌，而也會出現和捷運藍線一樣，「部份地下化」的變化。\n\n葉昭甫說，捷運藍線的規劃目前是從台中火車站到東海大學都是以地下化為主，而橘線的地下化部份，目前也是以原台中市區的方向為主，而目前發展中的水湳經貿園區，也會有橘線通過，此段會以地下化為主。\n\n葉昭甫說，其實如果以地下化來說，經費及工期都不是太大的問題，但是因為捷運綠線是高架，屆時橘線如果有部份地下，將和藍線一樣，高架及地下捷運的車站共構的技術問題，屆時將會是研究的重點。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3153964?utm_medium=P\n6.備註:\n        可不依內建發文格式填寫，但一定要有1~5項，若要加上心得或備註，請於文章最後面加上。\n\n市中心向外延伸應該都要地下化。\n
## 3: 1.媒體來源:\n自由時報\n\n2.記者署名：\n唐在馨\n\n3.完整新聞標題:\n大變革？台中捷運橘線規劃改部份地下化\n\n4.完整新聞內文：\n\n〔記者唐在馨／台中報導〕台中捷運文心線預計今年底會正式營運，市府同步也在進行藍線及橘線的規劃，據指出，「盧秀燕版」的捷運橘線將重新規劃部份地下化的的可行性，而這是否造成預算規模及推動時程的增加？交通局長葉昭甫表示「待評估」。\n\n據指出，台中捷運橘線是前市長胡志強時代開始推動，主要路線是中清路（過去的大雅路），串連清泉崗機場到火車站，但到前市長林佳龍時代則改推雙港輕軌，路線串連清泉崗及台中港之外，也朝路面上輕軌捷運為主。\n\n不過，市長盧秀燕上任後，目前捷運橘線正在做可行性規劃，交通局長葉昭甫說，因為前面二任市長的路線有做一些更動，目前市府也針對優缺點做評估，主路線不變，但應該不會做輕軌，而也會出現和捷運藍線一樣，「部份地下化」的變化。\n\n葉昭甫說，捷運藍線的規劃目前是從台中火車站到東海大學都是以地下化為主，而橘線的地下化部份，目前也是以原台中市區的方向為主，而目前發展中的水湳經貿園區，也會有橘線通過，此段會以地下化為主。\n\n葉昭甫說，其實如果以地下化來說，經費及工期都不是太大的問題，但是因為捷運綠線是高架，屆時橘線如果有部份地下，將和藍線一樣，高架及地下捷運的車站共構的技術問題，屆時將會是研究的重點。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3153964?utm_medium=P\n6.備註:\n        可不依內建發文格式填寫，但一定要有1~5項，若要加上心得或備註，請於文章最後面加上。\n\n市中心向外延伸應該都要地下化。\n
## 4: 1.媒體來源:\n自由時報\n\n2.記者署名：\n唐在馨\n\n3.完整新聞標題:\n大變革？台中捷運橘線規劃改部份地下化\n\n4.完整新聞內文：\n\n〔記者唐在馨／台中報導〕台中捷運文心線預計今年底會正式營運，市府同步也在進行藍線及橘線的規劃，據指出，「盧秀燕版」的捷運橘線將重新規劃部份地下化的的可行性，而這是否造成預算規模及推動時程的增加？交通局長葉昭甫表示「待評估」。\n\n據指出，台中捷運橘線是前市長胡志強時代開始推動，主要路線是中清路（過去的大雅路），串連清泉崗機場到火車站，但到前市長林佳龍時代則改推雙港輕軌，路線串連清泉崗及台中港之外，也朝路面上輕軌捷運為主。\n\n不過，市長盧秀燕上任後，目前捷運橘線正在做可行性規劃，交通局長葉昭甫說，因為前面二任市長的路線有做一些更動，目前市府也針對優缺點做評估，主路線不變，但應該不會做輕軌，而也會出現和捷運藍線一樣，「部份地下化」的變化。\n\n葉昭甫說，捷運藍線的規劃目前是從台中火車站到東海大學都是以地下化為主，而橘線的地下化部份，目前也是以原台中市區的方向為主，而目前發展中的水湳經貿園區，也會有橘線通過，此段會以地下化為主。\n\n葉昭甫說，其實如果以地下化來說，經費及工期都不是太大的問題，但是因為捷運綠線是高架，屆時橘線如果有部份地下，將和藍線一樣，高架及地下捷運的車站共構的技術問題，屆時將會是研究的重點。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3153964?utm_medium=P\n6.備註:\n        可不依內建發文格式填寫，但一定要有1~5項，若要加上心得或備註，請於文章最後面加上。\n\n市中心向外延伸應該都要地下化。\n
## 5: 1.媒體來源:\n自由時報\n\n2.記者署名：\n唐在馨\n\n3.完整新聞標題:\n大變革？台中捷運橘線規劃改部份地下化\n\n4.完整新聞內文：\n\n〔記者唐在馨／台中報導〕台中捷運文心線預計今年底會正式營運，市府同步也在進行藍線及橘線的規劃，據指出，「盧秀燕版」的捷運橘線將重新規劃部份地下化的的可行性，而這是否造成預算規模及推動時程的增加？交通局長葉昭甫表示「待評估」。\n\n據指出，台中捷運橘線是前市長胡志強時代開始推動，主要路線是中清路（過去的大雅路），串連清泉崗機場到火車站，但到前市長林佳龍時代則改推雙港輕軌，路線串連清泉崗及台中港之外，也朝路面上輕軌捷運為主。\n\n不過，市長盧秀燕上任後，目前捷運橘線正在做可行性規劃，交通局長葉昭甫說，因為前面二任市長的路線有做一些更動，目前市府也針對優缺點做評估，主路線不變，但應該不會做輕軌，而也會出現和捷運藍線一樣，「部份地下化」的變化。\n\n葉昭甫說，捷運藍線的規劃目前是從台中火車站到東海大學都是以地下化為主，而橘線的地下化部份，目前也是以原台中市區的方向為主，而目前發展中的水湳經貿園區，也會有橘線通過，此段會以地下化為主。\n\n葉昭甫說，其實如果以地下化來說，經費及工期都不是太大的問題，但是因為捷運綠線是高架，屆時橘線如果有部份地下，將和藍線一樣，高架及地下捷運的車站共構的技術問題，屆時將會是研究的重點。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3153964?utm_medium=P\n6.備註:\n        可不依內建發文格式填寫，但一定要有1~5項，若要加上心得或備註，請於文章最後面加上。\n\n市中心向外延伸應該都要地下化。\n
## 6: 1.媒體來源:\n自由時報\n\n2.記者署名：\n唐在馨\n\n3.完整新聞標題:\n大變革？台中捷運橘線規劃改部份地下化\n\n4.完整新聞內文：\n\n〔記者唐在馨／台中報導〕台中捷運文心線預計今年底會正式營運，市府同步也在進行藍線及橘線的規劃，據指出，「盧秀燕版」的捷運橘線將重新規劃部份地下化的的可行性，而這是否造成預算規模及推動時程的增加？交通局長葉昭甫表示「待評估」。\n\n據指出，台中捷運橘線是前市長胡志強時代開始推動，主要路線是中清路（過去的大雅路），串連清泉崗機場到火車站，但到前市長林佳龍時代則改推雙港輕軌，路線串連清泉崗及台中港之外，也朝路面上輕軌捷運為主。\n\n不過，市長盧秀燕上任後，目前捷運橘線正在做可行性規劃，交通局長葉昭甫說，因為前面二任市長的路線有做一些更動，目前市府也針對優缺點做評估，主路線不變，但應該不會做輕軌，而也會出現和捷運藍線一樣，「部份地下化」的變化。\n\n葉昭甫說，捷運藍線的規劃目前是從台中火車站到東海大學都是以地下化為主，而橘線的地下化部份，目前也是以原台中市區的方向為主，而目前發展中的水湳經貿園區，也會有橘線通過，此段會以地下化為主。\n\n葉昭甫說，其實如果以地下化來說，經費及工期都不是太大的問題，但是因為捷運綠線是高架，屆時橘線如果有部份地下，將和藍線一樣，高架及地下捷運的車站共構的技術問題，屆時將會是研究的重點。\n\n\n5.完整新聞連結 (或短網址):\nhttps://news.ltn.com.tw/news/life/breakingnews/3153964?utm_medium=P\n6.備註:\n        可不依內建發文格式填寫，但一定要有1~5項，若要加上心得或備註，請於文章最後面加上。\n\n市中心向外延伸應該都要地下化。\n
##      cmtPoster cmtStatus                               cmtContent
## 1:     Green23        →                            :台中捷運zzzz
## 2: tetsuya0310        →                             :債務揹起來!
## 3:     bg00004        推 :是很好啦~但是等做出來大家都已經離世了吧
## 4: Howard61313        →            :這條蠻重要的，最好走到三民路
## 5:     gameguy        →                :不是全面地下化，先噓先噓
## 6:     bg00004        →                :橘線會通過一中那邊沒錯啊

2. 資料前處理

使用默認參數初始化一個斷詞引擎

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

# 把文章和留言的斷詞結果併在一起
# MToken <- MetaData %>% unnest_tokens(word, sentence, token=ptt_tokenizer)
# RToken <- Reviews %>% unnest_tokens(word, cmtContent, token=ptt_tokenizer)
# 
# # 把資料併在一起
# data <- rbind(MToken[,c("artDate","artUrl", "word")],RToken[,c("artDate","artUrl", "word")])
# 
# head(RToken, 3)

計算每篇文章各token出現次數

tokens <- MetaData %>%
  unnest_tokens(word, sentence, token=ptt_tokenizer) %>%
  filter((!str_detect(word, regex("[0-9a-zA-Z]"))) | str_detect(word, regex("[Aa][Zz]"))) %>%
  count(artUrl, word) %>%
  rename(count=n)
tokens

##                                                            artUrl     word
##     1:   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html     備註
##     2:   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html     變革
##     3:   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html     變化
##     4:   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html     不變
##     5:   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html     不依
##    ---                                                                    
## 48082: https://www.ptt.cc/bbs/TaichungBun/M.1620186748.A.317.html     這裡
## 48083: https://www.ptt.cc/bbs/TaichungBun/M.1620186748.A.317.html     整理
## 48084: https://www.ptt.cc/bbs/TaichungBun/M.1620186748.A.317.html     中國
## 48085: https://www.ptt.cc/bbs/TaichungBun/M.1620186748.A.317.html 最新消息
## 48086: https://www.ptt.cc/bbs/TaichungBun/M.1620186748.A.317.html     作者
##        count
##     1:     2
##     2:     1
##     3:     1
##     4:     1
##     5:     1
##    ---      
## 48082:     2
## 48083:     1
## 48084:     1
## 48085:     1
## 48086:     1

save.image(file = "token_result.rdata")

將資料轉換為Document Term Matrix (DTM)

dtm <-tokens %>% cast_dtm(artUrl, word, count)
dtm

## <<DocumentTermMatrix (documents: 480, terms: 11057)>>
## Non-/sparse entries: 48086/5259274
## Sparsity           : 99%
## Maximal term length: 30
## Weighting          : term frequency (tf)

inspect(dtm[1:10,1:10])

## <<DocumentTermMatrix (documents: 10, terms: 10)>>
## Non-/sparse entries: 15/85
## Sparsity           : 85%
## Maximal term length: 2
## Weighting          : term frequency (tf)
## Sample             :
##                                                           Terms
## Docs                                                       備註 變革 變化 不變
##   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html    2    1    1    1
##   https://www.ptt.cc/bbs/Gossiping/M.1588559009.A.670.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588562255.A.77E.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588569392.A.358.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588582698.A.3E5.html    1    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588990735.A.4C6.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588991252.A.EB0.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1589116258.A.627.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1590129143.A.C2C.html    1    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1590133343.A.03A.html    0    0    0    0
##                                                           Terms
## Docs                                                       不依 部份 車站 出現
##   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html    1    5    1    1
##   https://www.ptt.cc/bbs/Gossiping/M.1588559009.A.670.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588562255.A.77E.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588569392.A.358.html    0    0    1    1
##   https://www.ptt.cc/bbs/Gossiping/M.1588582698.A.3E5.html    0    2    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588990735.A.4C6.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588991252.A.EB0.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1589116258.A.627.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1590129143.A.C2C.html    0    0    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1590133343.A.03A.html    0    0    0    0
##                                                           Terms
## Docs                                                       串連 此段
##   https://www.ptt.cc/bbs/Gossiping/M.1588555751.A.3F0.html    2    1
##   https://www.ptt.cc/bbs/Gossiping/M.1588559009.A.670.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588562255.A.77E.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588569392.A.358.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588582698.A.3E5.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588990735.A.4C6.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1588991252.A.EB0.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1589116258.A.627.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1590129143.A.C2C.html    0    0
##   https://www.ptt.cc/bbs/Gossiping/M.1590133343.A.03A.html    0    0

3. LDA主題模型

建立LDA模型

lda <- LDA(dtm, k = 2, control = list(seed = 2021))
# lda <- LDA(dtm, k = 2, control = list(seed = 2021,alpha = 2,delta=0.1),method = "Gibbs") #調整alpha即delta
lda

## A LDA_VEM topic model with 2 topics.

利用LDA模型建立phi矩陣

topics_words <- tidy(lda, matrix = "beta") #注意，在tidy function裡面要使用"beta"來取出Phi矩陣。
colnames(topics_words) <- c("topic", "term", "phi")
topics_words

## # A tibble: 22,114 x 3
##    topic term       phi
##    <int> <chr>    <dbl>
##  1     1 備註  1.73e- 3
##  2     2 備註  1.77e- 3
##  3     1 變革  2.13e- 9
##  4     2 變革  8.34e- 5
##  5     1 變化  3.05e- 4
##  6     2 變化  1.03e- 6
##  7     1 不變  3.22e- 5
##  8     2 不變  7.90e- 5
##  9     1 不依  1.64e-10
## 10     2 不依  2.78e- 5
## # … with 22,104 more rows

尋找Topic的代表字

terms依照各主題的phi值由大到小排序，列出前10大代表字

topics_words %>%
  group_by(topic) %>%
  top_n(10, phi) %>%
  ungroup() %>%
  mutate(top_words = reorder_within(term,phi,topic)) %>%
  ggplot(aes(x = top_words, y = phi, fill = as.factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip() +
  scale_x_reordered() +
  theme_grey(base_family = "STKaiti" ) #避免中文出現亂碼

4. 尋找最佳主題數

建立更多主題的主題模型

嘗試2、4、6、10、15個主題數，將結果存起來，再做進一步分析。
（此部分需要跑一段時間，已經將跑完的檔案存成ldas_result.rdata，可以直接載入）

ldas = c()
topics = c(2,4,6,10,15)
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") # 將模型輸出成檔案
}

載入每個主題的LDA結果

load("ldas_result.rdata")

透過perplexity找到最佳主題數

topics = c(2,4,6,10,15)
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")

## Warning: `data_frame()` was deprecated in tibble 1.1.0.
## Please use `tibble()` instead.

主題數越多，複雜度越低，內容的純度越高。
可以挑選下降幅度減緩的點。

產生LDAvis結果

create LDAvis所需的json function
此function是將前面使用 “LDA function”所建立的model，轉換為“LDAVis”套件的input格式。

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)
}

the_lda = ldas[[2]]
json_res <- topicmodels_json_ldavis(the_lda,dtm)
serVis(json_res,open.browser = T)

圓的大小代表有多少documents
圓如果分越開，則表示每個主題都有獨特性。
Slide to adjust relevance metric的部分，紅色代表phi，且λ調越小則越可以看出每個字的唯一性。

產生LDAvis檔案，存至local端

serVis(json_res, out.dir = "vis", open.browser = T)
writeLines(iconv(readLines("./vis/lda.json"), to = "UTF8"))

從LDAvis分析結果中可以初度得知這四個主題的討論方向：

「運價」、「票價」、「站名」、「高捷」等字詞，推測是討論台中捷運基本營運規劃的相關事項。
「藍線」、「經費」、「林佳龍」等字詞，推測是討論中捷藍線經費相關議題。
「軸心」、「故障」、「斷裂」、「川崎」等字詞，推測是討論中捷的斷軌事件。
「改善」、「履勘」、「委員」、「初勘」等字詞，推測是討論台中捷運試營運的相關經驗與建議。

5. LDA分析

選定4個主題數的主題模型

the_lda = ldas[[2]] ## 選定topic 為 4 的結果

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     4 軸心   0.0203
##  2     4 營運   0.0177
##  3     1 運量   0.0174
##  4     2 綠線   0.0163
##  5     2 營運   0.0154
##  6     2 通車   0.0145
##  7     1 通車   0.0131
##  8     1 綠線   0.0127
##  9     4 故障   0.0121
## 10     2 交通部 0.0119

terms依照各主題的phi值由大到小排序

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() +
  theme_grey(base_family = "STKaiti" ) #避免中文出現亂碼

去除共通詞彙

e.g., 捷運、台中、中捷等等

removed_word = c("捷運","台中","中捷","可以","表示","台中市","沒有","真的","交通","交通部")

topics_words %>%
  filter(!term  %in% removed_word) %>%
  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() +
  theme_grey(base_family = "STKaiti" ) #避免中文出現亂碼

主題命名

topics_name = c("台中捷運通車","綠線11月試營運","藍線經費暴增爭議","台中捷運斷軌事件")

透過上述字詞，可將其分為以下主題：

Topic為「通車」、「公車」等等字詞，因此可推得第一張圖的主題為台中捷運通車（2021/04/25）
Topic為「試營運」、「綠線」等等字詞，因此可推得第二張圖的主題為綠線試營運，另外，由於中捷的綠線是沿著文心路到台中高鐵站的，所以第二張圖的主題字也出現「高鐵」。（2020/11/16）
Topic為「藍線」、「市府」等等字詞，由於中捷藍線經費跟預算暴增，因此第三張圖也出現關於「運量」等相關討論，可推得第三張圖的主題為藍線經費暴增爭議。（2021/03）
Topic為「軸心」、「故障」、「斷裂」等等字詞，因此可以推得第四張圖的主題為台中捷運斷軌事件。（2020/11/21）

Document 主題分佈

# for every document we have a probability distribution of its contained topics
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
ptt_topic = cbind(MetaData,document_topics_df)

# 刪除commentNum、push、boo欄位
ptt_topic$commentNum = NULL
ptt_topic$push = NULL
ptt_topic$boo = NULL

查看特定主題的文章

透過找到特定文章的分佈進行排序之後，可以看到此主題的比重高的文章在討論什麼。

ptt_topic %>%
  arrange(desc(`台中捷運通車`)) %>%head(10)

## 了解主題在時間的變化
# ptt_topic %>% 
#   mutate(artDate = as.Date(artDate)) %>%
#   group_by(artDate = format(artDate,'%Y%m')) %>%
#   summarise_if(is.numeric, sum, na.rm = TRUE) %>%
#   melt(id.vars = "artDate")%>%
#   ggplot( aes(x=artDate, y=value, fill=variable)) + 
#   geom_bar(stat = "identity") + ylab("value") + 
#   #scale_fill_manual(values=c("#FFD449","#80AB82","#2F6690","#EF8354"))+
#   scale_fill_manual(values=c("#cacaca","#a9c6de","#5588a3","#145374"))+
#   theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
#   theme_grey(base_family = "STKaiti" ) #避免中文出現亂碼

去除筆數少月份

ptt_topic %>%
  mutate(artDate = as.Date(artDate)) %>%
  filter( !format(artDate,'%Y%m') %in% c(202005, 202006, 202007, 202008, 202009, 202010, 202101, 202102, 202105))%>%
  group_by(artDate = format(artDate,'%Y%m')) %>%
  summarise_if(is.numeric, sum, na.rm = TRUE) %>%
  melt(id.vars = "artDate")%>%
  ggplot( aes(x=artDate, y=value, fill=variable)) +
  geom_bar(stat = "identity") + ylab("value") +
  scale_fill_manual(values=c("#cacaca","#a9c6de","#5588a3","#145374"))+
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  theme_grey(base_family = "STKaiti" ) #避免中文出現亂碼

從這張圖中可以看到，對應到前面的文章討論數量分佈圖，討論數量較高的月份剛好是「2020/11-2020/12月之間」、「2021/03月中旬」、「2021/04月中下旬」這些時間點。

其中，從圖中的主題分佈可以推得：

2020/11-2020/12這段時間對於中捷的討論主題為試營運通車（2020/11/16）之後，斷軌事件（2020/11/21）發生的事件。
2021/03這段時間主要的討論主題在於捷運藍線經費暴增的爭議。
2021/04這段時間除了藍線議題持續被討論以外，中捷在4/25正式通車之後也備受關注。

以比例了解主題時間變化

ptt_topic %>%
  mutate(artDate = as.Date(artDate)) %>% 
  filter( !format(artDate,'%Y%m') %in% c(202005, 202006, 202007, 202008, 202009, 202010, 202101, 202102, 202105))%>%
  group_by(artDate = format(artDate,'%Y%m')) %>%
  summarise_if(is.numeric, sum, na.rm = TRUE) %>%
  melt(id.vars = "artDate")%>%
  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=c("#cacaca","#a9c6de","#5588a3","#145374"))+
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) + 
  theme_grey(base_family = "STKaiti" ) #避免中文出現亂碼

從這張比例圖可以驗證上述的推論：

2020/11的討論主題為試營運通車以及斷軌事件。
2020/12斷軌事件的討論持續延燒。
2021/03的討論主題為藍線經費暴增的爭議。
2021/04由於正式通車，因此討論度較高。

6. 社群網路圖

整理文章討論參與人

# 取出 cmtPoster（回覆者）、artPoster（發文者）、artUrl（文章連結）三個欄位
link <- Reviews %>%
      select(cmtPoster, artPoster, artUrl)

reviewNetwork <- graph_from_data_frame(d=link, directed=T)

## Warning in graph_from_data_frame(d = link, directed = T): In `d' `NA' elements
## were replaced with string "NA"

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

## [1] 282

# 留言者數量 6180
length(unique(Reviews$cmtPoster))

## [1] 6180

# 參與者總數量 6350
allPoster <- c(MetaData$artPoster, Reviews$cmtPoster)
length(unique(allPoster))

## [1] 6305

# 整理所有出現過的使用者：
# 若曾發過文則標註爲：Poster；不曾發過文則標註爲：Replyer
userList <- data.frame(user = unique(allPoster)) %>%
  mutate(type = ifelse(user%in%MetaData$artPoster, "poster", "replyer"))

資料篩選

# 看一下留言數大概都多少（方便後面篩選）
MetaData %>%
filter(commentNum < 200) %>%
  ggplot(aes(x=commentNum)) + geom_histogram()

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

文章回覆數量大約在回覆次數 100 後就比較少了，因此回覆數可以先抓 100。

MRT_poster = table(MetaData$artPoster) %>% sort %>% as.data.frame 
colnames(MRT_poster) = c("artPoster","freq")
MRT_poster = MRT_poster %>% filter(freq >= 5) # 發文次數 > 5

link <- Reviews %>%
      filter(commentNum >= 100) %>% # 回覆數 > 100
      filter(artPoster==MRT_poster$artPoster) %>%
      select(cmtPoster, artPoster, artUrl) %>% 
      unique()

## Warning in `==.default`(artPoster, MRT_poster$artPoster): 較長的物件長度並非較短
## 物件長度的倍數

## Warning in is.na(e1) | is.na(e2): 較長的物件長度並非較短物件長度的倍數

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

建立網路關係圖

set.seed(487)
# 先把關係的方向性拿掉，減少圖片中的不必要的資訊
reviewNetwork <- graph_from_data_frame(d=link, v=filtered_user, directed=F)
plot(reviewNetwork, vertex.size=3, edge.arrow.size=.2, vertex.label=NA)

加強圖像顯示資訊

set.seed(487)
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
# 依使用者的身份來區分點的顏色：有發文的話是紅色，只有回覆文章的則是淺藍色
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "red", "lightblue")

# 顯示超過 20 個關聯的使用者帳號
plot(reviewNetwork, vertex.size = 3, edge.arrow.size=.2,
     vertex.label=ifelse(degree(reviewNetwork) >= 20, V(reviewNetwork)$label, NA),  vertex.label.font = 2)

從圖中可以發現 Ruby0914、LoliconWei、iamshana、Kitakami 這四個帳號發的文章中有較多的回覆。

意見領袖分析

進一步分析 Ruby0914、LoliconWei、iamshana、Kitakami 這四位意見領袖

leader_data <- MetaData %>% 
  filter((artPoster == "Ruby0914")|(artPoster == "LoliconWei")|(artPoster == "iamshana")|(artPoster == "Kitakami")) 

leader_data$artDate = as.Date(leader_data$artDate)
leader_data = leader_data %>% mutate(months = as.Date(cut(artDate, "months")))
leader_data_month = leader_data %>% group_by(months,artPoster) %>%
  summarise(num=n()) %>% as.data.frame

## `summarise()` has grouped output by 'months'. You can override using the `.groups` argument.

# 整合發文趨勢圖
leader_data_month %>% ggplot(aes(x= months,y=num,fill=artPoster))  +geom_bar(stat = "identity")+
  facet_wrap(~artPoster, ncol = 2, scales = "fixed")

由圖中可以推測：

Kitakami、Ruby0914 這兩個帳號對於中捷的議題算是一直持續有在關注，並且發表意見的。
iamshana 的話主要關注比較具討論性的議題，像是 2020/11 的試營運以及斷軌事件，還有後續 2021/3-4 藍線議題與中捷正式通車。
LoliconWei 則是在 2021 年之前對於中捷議題比較有在關注，2021 年之後就比較少有評論產生。

作者 iamshana 分析

文字雲

iamshana_data <- leader_data %>% 
  filter(artPoster == "iamshana")
iamshana_sentence <- iamshana_data %>% 
  select(artUrl,sentence)
  
iamshana_sentence <-strsplit(iamshana_sentence$sentence,"[。！；？!?;]")

# 將每個句子與所屬的文章連結配對起來，整理成 dataframe
iamshana_sentence  <- data.frame(
  artUrl = rep(iamshana_data$artUrl, sapply(iamshana_sentence, length)), 
  sentence = unlist(iamshana_sentence)) %>%
  filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
iamshana_sentence$sentence <- as.character(iamshana_sentence$sentence)

# 使用斷詞引擎，放入要用的詞典和停用字
jieba_tokenizer = worker(user="../dict/user_dict.txt", stop_word = "dict/stop_words.txt")
ptt_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

# 進行斷詞，並計算各詞彙在各文章中出現的次數
iamshana_word <- iamshana_sentence %>%
  unnest_tokens(word, sentence, token=ptt_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
  count(artUrl, word, sort = TRUE)

# 畫出文字雲
# iamshana_word %>%
#   group_by(word) %>%
#   summarise(sum = n()) %>%
#   filter(sum > 3)  %>%
#   arrange(desc(sum)) %>%
#   wordcloud2()

詞彙相關性

# 計算兩個詞彙間的相關性
iamshana_word_cors <- iamshana_word %>%
  group_by(word) %>%
  filter(n() >= 5) %>%
  pairwise_cor(word, artUrl, sort = TRUE)

## Warning: `tbl_df()` was deprecated in dplyr 1.0.0.
## Please use `tibble::as_tibble()` instead.

iamshana_word_cors %>%
  filter(correlation > 0.3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) + 
  geom_node_point(color = "lightblue", size = 3) +
  geom_node_text(aes(label = name), repel = TRUE, family='STXihei') +
  theme_void()

對應到前面各作者在每個月文章數量分析圖，可以看出作者 iamshana 在前面分析中提到的四大主題月份都有較多的文章討論，加上文字雲以及詞彙相關性分析後可以推測出其在 2020/11 主要的貼文比較與綠線試營運有關，斷軌事件的討論比較少；2021/03-04 其間，討論的焦點主要在正式營運，而不是藍線經費爭議的事件。

作者 LoliconWei 分析

文字雲

LoliconWei_data <- leader_data %>% 
  filter(artPoster == "LoliconWei")
LoliconWei_sentence <- LoliconWei_data %>% 
  select(artUrl,sentence)
  
LoliconWei_sentence <-strsplit(LoliconWei_sentence$sentence,"[。！；？!?;]")

# 將每個句子與所屬的文章連結配對起來，整理成 dataframe
LoliconWei_sentence  <- data.frame(
  artUrl = rep(LoliconWei_data$artUrl, sapply(LoliconWei_sentence, length)), 
  sentence = unlist(LoliconWei_sentence)) %>%
  filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
LoliconWei_sentence$sentence <- as.character(LoliconWei_sentence$sentence)

# 使用斷詞引擎，放入要用的詞典和停用字
jieba_tokenizer = worker(user="../dict/user_dict.txt", stop_word = "dict/stop_words.txt")
ptt_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

# 進行斷詞，並計算各詞彙在各文章中出現的次數
LoliconWei_word <- LoliconWei_sentence %>%
  unnest_tokens(word, sentence, token=ptt_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
  count(artUrl, word, sort = TRUE)

# 畫出文字雲
# LoliconWei_word %>%
#   group_by(word) %>%
#   summarise(sum = n()) %>%
#   filter(sum > 3)  %>%
#   arrange(desc(sum)) %>%
#   wordcloud2()

詞彙相關性

# 計算兩個詞彙間的相關性
LoliconWei_word_cors <- LoliconWei_word %>%
  group_by(word) %>%
  filter(n() >= 4) %>%
  pairwise_cor(word, artUrl, sort = TRUE)

LoliconWei_word_cors %>%
  filter(correlation > 0.3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) + 
  geom_node_point(color = "lightblue", size = 3) +
  geom_node_text(aes(label = name), repel = TRUE, family='STXihei') +
  theme_void()

對應到前面各作者在每個月文章數量分析圖，可以發現作者 LoliconWei 發文數量較多的期間在 2020/11 月，再加上文字雲的分析，可以看出其主要關注的議題為「綠線試營運」以及「斷軌事件」。

作者 Kitakami 分析

文字雲

Kitakami_data <- leader_data %>% 
  filter(artPoster == "Kitakami")
Kitakami_sentence <- Kitakami_data %>% 
  select(artUrl,sentence)
  
Kitakami_sentence <-strsplit(Kitakami_sentence$sentence,"[。！；？!?;]")

# 將每個句子與所屬的文章連結配對起來，整理成 dataframe
Kitakami_sentence  <- data.frame(
  artUrl = rep(Kitakami_data$artUrl, sapply(Kitakami_sentence, length)), 
  sentence = unlist(Kitakami_sentence)) %>%
  filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
Kitakami_sentence$sentence <- as.character(Kitakami_sentence$sentence)

# 使用斷詞引擎，放入要用的詞典和停用字
jieba_tokenizer = worker(user="../dict/user_dict.txt", stop_word = "dict/stop_words.txt")
ptt_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

# 進行斷詞，並計算各詞彙在各文章中出現的次數
Kitakami_word <- Kitakami_sentence %>%
  unnest_tokens(word, sentence, token=ptt_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
  count(artUrl, word, sort = TRUE)

# 畫出文字雲
# Kitakami_word %>%
#   group_by(word) %>%
#   summarise(sum = n()) %>%
#   filter(sum > 3)  %>%
#   arrange(desc(sum)) %>%
#   wordcloud2()

詞彙相關性

# 計算兩個詞彙間的相關性
Kitakami_word_cors <- Kitakami_word %>%
  group_by(word) %>%
  filter(n() >= 7) %>%
  pairwise_cor(word, artUrl, sort = TRUE)

Kitakami_word_cors %>%
  filter(correlation > 0.3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) + 
  geom_node_point(color = "lightblue", size = 3) +
  geom_node_text(aes(label = name), repel = TRUE, family='STXihei') +
  theme_void()

對應到前面各作者在每個月文章數量分析圖，作者 Kitakami 文章較多的期間是在 2020/11-12 月，並結合文字雲分析及詞彙相關性分析，可以推測出其關注的議題比較偏向「綠線通車」以及「斷軌事件」的討論。

作者 Ruby0914 分析

文字雲

Ruby0914_data <- leader_data %>% 
  filter(artPoster == "Ruby0914")
Ruby0914_sentence <- Ruby0914_data %>% 
  select(artUrl,sentence)
  
Ruby0914_sentence <-strsplit(Ruby0914_sentence$sentence,"[。！；？!?;]")

# 將每個句子與所屬的文章連結配對起來，整理成 dataframe
Ruby0914_sentence  <- data.frame(
  artUrl = rep(Ruby0914_data$artUrl, sapply(Ruby0914_sentence, length)), 
  sentence = unlist(Ruby0914_sentence)) %>%
  filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
Ruby0914_sentence$sentence <- as.character(Ruby0914_sentence$sentence)

# 使用斷詞引擎，放入要用的詞典和停用字
jieba_tokenizer = worker(user="../dict/user_dict.txt", stop_word = "dict/stop_words.txt")
ptt_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

# 進行斷詞，並計算各詞彙在各文章中出現的次數
Ruby0914_word <- Ruby0914_sentence %>%
  unnest_tokens(word, sentence, token=ptt_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
  count(artUrl, word, sort = TRUE)

# 畫出文字雲
# Ruby0914_word %>%
#   group_by(word) %>%
#   summarise(sum = n()) %>%
#   filter(sum > 3)  %>%
#   arrange(desc(sum)) %>%
#   wordcloud2()

詞彙相關性

# 計算兩個詞彙間的相關性
Ruby0914_word_cors <- Ruby0914_word %>%
  group_by(word) %>%
  filter(n() >= 5) %>%
  pairwise_cor(word, artUrl, sort = TRUE)

Ruby0914_word_cors %>%
  filter(correlation > 0.3) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) + 
  geom_node_point(color = "lightblue", size = 3) +
  geom_node_text(aes(label = name), repel = TRUE, family='STXihei') +
  theme_void()

對應到前面各作者在每個月文章數量分析圖，再加上文字雲的分析，可以看出作者 Ruby0914 主要關注的部分在於 2021/04 綠線正式營運的部分。

使用者是否受到歡迎

filter_degree = 5 # 使用者degree

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

# 接下來把網路圖畫出來
# 篩選link中有出現的使用者
filtered_user <- userList %>%
          filter(user%in%link$cmtPoster | user%in%link$artPoster) %>%
          arrange(desc(type))

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

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


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

# 畫出社群網路圖
set.seed(5432)
plot(reviewNetwork, vertex.size=2, edge.width=3, vertex.label.dist=1,
     vertex.label=ifelse(degree(reviewNetwork) > filter_degree, V(reviewNetwork)$label, NA),vertex.label.font=2)

# 加入標示
par(family='STXihei')
legend("bottomright", c("發文者","回文者"), pch=21,
  col="#777777", pt.bg=c("red","lightblue"), pt.cex=1, cex=1) 
legend("topleft", c("推","噓"), 
       col=c("#cacaca", "#5588a3"), lty=1, cex=1)

可以發現本次的討論中推文較多、噓文較少。

利用 NetworkD3 畫圖

library(networkD3)
links = link
nodes = filtered_user
nodes$id = 0:(length(nodes$user) - 1)

# 整理資料格式
nodes_complete <- data.frame(nodeID = unique(c(links$cmtPoster, links$artPoster)))
nodes_complete$group <- nodes$type[match(nodes_complete$nodeID, nodes$user)]
links$source <- match(links$cmtPoster, nodes_complete$nodeID) - 1
links$target <- match(links$artPoster, nodes_complete$nodeID) - 1

# 畫圖
library(networkD3)
forceNetwork(Links = links, Nodes = nodes_complete, Source = "source", 
             Target = "target", NodeID = "nodeID", Group = "group", 
             opacity = 0.8, fontSize = 10, zoom = TRUE,legend = TRUE, opacityNoHover = TRUE,
             
             colourScale = "d3.scaleOrdinal(d3.schemeCategory10);",
             linkColour = ifelse(links$cmtStatus == "推", "#cacaca", "#5588a3")  # 設定推噓顏色
             )

## Links is a tbl_df. Converting to a plain data frame.

7. 結論

從 2020-05-01 ~ 2021-05-15 PTT版上關於「中捷」的相關討論，結合文章與留言在各個月的數量，可以歸納出四個主題：

“綠線11月試營運”：2020/11的討論主題為試營運通車以及斷軌事件。
“台中捷運斷軌事件”：2020/12斷軌事件的討論持續延燒。
“藍線經費暴增爭議”：2021/03的討論主題為藍線經費暴增的爭議。
“台中捷運通車”：2021/04由於正式通車，因此討論度較高。

透過社群網路圖我們發現，有發文數比較多以及比較少的使用者：

發文數比較少的使用者我們推測他主要是長期潛伏在PTT內，只參與中捷相關議題討論而不發表文章。
而對於發文數多的人，我們透過他們文章的文字雲以及詞彙相關性分析，發現其中幾個使用者會在某些特定時段的發文，並具有較高的傾向性，一個人發的文章主要只涉及一個主題（e.g., Ruby0914）；但比較多的使用者則是沒有那麼高的傾向性，在討論聲量較高的議題皆有涉及（e.g., 其餘三個意見領袖）。

社群網絡分析ptt平台上台中捷運相關資料

第五組｜陳冠如、陳姸君、吳晉榮、蘇舫萱、許芳瑄、蔡宗耀

5/29/2021

1. 套件取得及資料載入

套件載入

資料描述

2. 資料前處理

將資料轉換為Document Term Matrix (DTM)

3. LDA主題模型

建立LDA模型

利用LDA模型建立phi矩陣

尋找Topic的代表字

4. 尋找最佳主題數

建立更多主題的主題模型

透過perplexity找到最佳主題數

產生LDAvis結果

產生LDAvis檔案，存至local端

5. LDA分析

選定4個主題數的主題模型

terms依照各主題的phi值由大到小排序

去除共通詞彙

主題命名

Document 主題分佈

查看特定主題的文章

去除筆數少月份

以比例了解主題時間變化

6. 社群網路圖

資料篩選

建立網路關係圖

加強圖像顯示資訊

意見領袖分析

作者 iamshana 分析

文字雲

詞彙相關性

作者 LoliconWei 分析

文字雲

詞彙相關性

作者 Kitakami 分析

文字雲

詞彙相關性

作者 Ruby0914 分析

文字雲

詞彙相關性

使用者是否受到歡迎

利用 NetworkD3 畫圖

7. 結論