期末報告：中美貿易戰-美國禁止華為事件討論分析
第四組：N074020007黃耀煌、N074020008陳禎妮、M064020017施采彣
2019/06/10
自中美貿易戰開始之後，許多產業與貿易進出口受到影響，不僅中國與美國相互提高對其商品課的關稅額度，05/20美國總統川普發布禁止使用與進口華為設備後，引起各界關注，除了股市波動、手機市場供給變化外，許多華為手機零件供應商開始進行應對措施，而Google也宣布將不再提供華為手機相關服務，而本次事件可能與5G通訊設備有所關聯，因此引發極大的討論。
本組擷取04/20至06/06之PTT八卦版上討論有關華為的文章與回覆，做為社群網路分析之主題，探討本次事件中，大多數人對於中美貿易戰、華為之看法，以及社群網路中常被討論的議題與方向為何，並藉由找出較具影響力之發文者及回覆者。
安裝需要的packages
##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union## Loading required package: jiebaRD##
## Attaching package: 'ggplot2'## The following object is masked from 'package:NLP':
##
## annotate##
## Attaching package: 'igraph'## 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##
## Attaching package: 'scales'## The following object is masked from 'package:readr':
##
## col_factor##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smiths##
## Attaching package: 'kableExtra'## The following object is masked from 'package:dplyr':
##
## group_rows##
## Attaching package: 'data.table'## The following objects are masked from 'package:reshape2':
##
## dcast, melt## The following objects are masked from 'package:dplyr':
##
## between, first, last## Loading required package: RColorBrewer文章資料分析
- 查看資料內容
- 列出前資料前 10 列
#載入原始資料集
post<- read_csv("./huawei_articleMetaData.csv") %>%
mutate(sentence=gsub("[\n]{2,}", "。", sentence))## Parsed with column specification:
## cols(
## artTitle = col_character(),
## artDate = col_date(format = ""),
## artTime = col_time(format = ""),
## artUrl = col_character(),
## artPoster = col_character(),
## artCat = col_character(),
## commentNum = col_integer(),
## push = col_integer(),
## boo = col_integer(),
## sentence = col_character()
## )post %>% head(10) %>% kable %>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
scroll_box(height = "300px")| artTitle | artDate | artTime | artUrl | artPoster | artCat | commentNum | push | boo | sentence |
|---|---|---|---|---|---|---|---|---|---|
| [新聞]CIA指控：華為接受中共資金挹注 | 2019-04-20 | 15:12:37 | https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | FiveSix911 | Gossiping | 45 | 21 | 2 | [青年] CIA指控：華為接受中共資金挹注。編譯江昱蓁／綜合外電報導。 英國《泰晤士報》20日披露，美「中央情報局」（CIA）指控中國大陸電信巨擘華為接 受來自中共「中央國家安全委員會」、共軍與國安情報部門的經費；儘管華為駁斥此一報 導，堅稱「匿名來源無憑無據」，但此一消息恐為該公司進軍英國5G通訊網路投下震撼彈 。。 報導指出，美、英、紐西蘭、加拿大、澳洲透過「五眼聯盟」分享國際情報，CIA在今 年年初獲得此一情報後，隨即提供給「五眼聯盟」。由於英國下一代通訊網已進入最後審 查階段，華為對此又野心勃勃，此時CIA報告格外引人矚目。。 事實上，包括英國首相梅伊、內閣成員與國安單位領導人，將在1週內召開國安會議商討 英國5G發展計畫，由於該報告可信程度極高，消息人士認為華為恐在5G競爭中出局。。 美國官員透露，華為向「五眼聯盟」成員銷售5G設備一事「大有問題」，在中國大陸並 無真正的私人企業可言，中共往往透過國家安全法規將手伸入私人公司，強迫其協助共軍 發展。。 雖然華為一再宣稱其為獨立的民營企業，不受政府影響也不存在任何資安風險，然而外 界質疑中共法律要求華為與國安單位配合，在軟體中安裝「後門程式」，藉以監視、破壞 英國通訊架構。 https://www.ydn.com.tw/News/333086 天知地知 你知我知 獨眼龍也知 |
| [問卦]不支持HTC買華為小米的族群在想什麼 | 2019-04-20 | 23:29:00 | https://www.ptt.cc/bbs/Gossiping/M.1555832102.A.AAA.html | ejcj0m | Gossiping | 30 | 12 | 6 | 當時很多人很不爽HTC因為政治因素 （扣掉前面的爛貨）。一堆台灣人拒買。結果最近小米華為要想買還買不一定買的到。有沒有不支持HTC但是買華為小米的族群在想什麼的八卦 |
| [新聞]質疑華為手機會自動P圖中國網媒主筆遭開除 | 2019-04-21 | 03:03:42 | https://www.ptt.cc/bbs/Gossiping/M.1555844984.A.246.html | oidioi11 | Gossiping | 160 | 123 | 0 | 質疑華為手機會自動P圖 中國網媒主筆遭開除。中央社 記者 陳家倫/翟思嘉。（中央社台北21日電）華為P30開賣，吸引粉絲漏夜排隊。不過中國一家科技網媒主筆日 前質疑P30 Pro拍攝月亮的照片「造假」，但網媒高管認為「算法優化不等於造假」，因 而將這名主筆開除。。華為P30的拍照功能一直是宣傳重點，日前對外展示拍月亮的驚人成果，吸引不少稱讚。 不過中國知名評測媒體愛否科技的主筆王躍琨在微博上質疑華為P30 Pro拍攝的月亮「好 像是P（修圖）上去的」。。觀察者網報導，王躍琨13日晚間曬了兩張P30 Pro拍月亮的對比圖，稱是自己分別用自動 模式和手動模式拍的。自動模式下拍攝到的月亮照片比手動多了好多東西，他認為「月亮 好像真的是P上去的」。。事後許多網友和科技博主跳出來反對他，表示沒有發現「P圖」問題。王躍琨澄清，表示 改用「AI計算出來的」來形容更為貼切，但他還是認為P30 Pro就是能自動添加細節。。愛否科技創辦人彭林16日晚間表示，拍月亮模式確實在算法上對原圖有所優化處理，但並 沒有到「P圖」的程度。王躍琨在拍攝驗證過程中選擇性地發布素材，則屬於「黑廠商」 的不專業行為。。於是，彭林直接宣布將王躍琨開除，並罰自己一個月工資，將愛否科技影音內容暫停更新 一個月。。但在王躍琨遭到開除後，部分輿論卻開始轉而支持王躍琨。有微博大V實測表示，簡單來 說，華為一旦AI識別為月亮，就會有「無中生有」的能力修補圖案，等於照著標準答案修 改自己的答案。。觀察者網並指，華為也確實有誤導消費者的嫌疑，華為的長焦性能雖然確實有領先同業， 但達不到呈現給消費者的宣傳效果。這樣看來，王躍琨才是需要接受道歉的一方。（編輯 ：陳家倫/翟思嘉）1080421 https://www.cna.com.tw/news/firstnews/201904210064.aspx |
| Re:[新聞]質疑華為手機會自動P圖中國網媒主筆遭開除 | 2019-04-21 | 04:12:28 | https://www.ptt.cc/bbs/Gossiping/M.1555849111.A.966.html | ororzzz | Gossiping | 3 | 2 | 0 | 其實我一直不懂為什麼手機一定跟相機或單眼比。硬體就差那麼多了。手機要有相機或單眼的成像一定是靠軟體。不過大家不是本來就知道各家的手機多多少少都會修圖。只是華為修的比較誇張。誇張到能把白冰冰修成李冰冰。韓冰修成范冰冰。所以有什麼好吵的? |
| [新聞]華為5G東南亞國家用定了！美國「王牌」 | 2019-04-21 | 04:16:43 | https://www.ptt.cc/bbs/Gossiping/M.1555849365.A.A6E.html | anti87 | Gossiping | 50 | 22 | 9 | https://ec.ltn.com.tw/article/breakingnews/2764929 華為5G東南亞國家用定了！美國「王牌」恐也挽不回。〔財經頻道／綜合報導〕中國電信商華為自去年起便深陷資安疑慮風暴，美國也以強勢的 西方國家影響力說服盟國拒用，形成一定程度的抵制潮。然而在地球的另一端，東南亞國 家幾乎無視美國警告，紛紛考慮或已與華為簽下5G合約，《南華早報》指出，華為自稱技 術領先且價格便宜，美國的「王牌」可能也比不上這2大優點，東南亞國家全數採用華為 恐成定局。。由於華為自稱其5G技術領先他廠12至18個月，價格還更低廉，主要東南亞國家都已選擇華 為。泰國希望2020年推出華為主導的5G服務，雙方已進行聯合研究；電信商如新加坡M1、 馬來西亞Maxis、印尼Telkomsel皆簽下試用；菲律賓最大的Globe Telecom甚至預計今年 Q2就會推出5G。此外，華為去年在東南亞地區的消費端業務成長近50%，該公司估計明年 將達8000萬用戶、未來5年將有1.2兆美元的商機。。《南華早報》指出，美國說服手段的「王牌」便是撤回與東南亞國家的情報或軍事合作。 然而，近10、20年來該地區已在經濟上更依賴中國，美國的影響力也隨之下降。。而5G通訊技術將再加深東西2大強權的差異。一直以來，美國鼓勵企業將5G頻譜較高的頻 率用於商業用途，低頻則作為安全通訊使用；中國則正好相反，是低頻作為商業用途。。智庫蘭德公司（Rand Corporation）分析師Timothy Heath指出，美國威脅取消軍事合作 可能適得其反，加速東南亞投向華為和中國懷抱，「因為5G網路也會改變未來的軍隊運作 ，採用華為可能表示不再能整合美國製造的武器系統和平台，使得與美聯合演訓和合作更 加困難。」。新加坡拉惹勒南國際研究學院（RSIS）軍事轉型助理教授Michael Raska則指出，誰建造 電信基礎設施，誰就可以定義後續的規範或標準，而風險在於中國出口的不只是硬體設備 ，還順帶出口中國網路那套「遊戲規則」。Raska認為，美國還是有機會拉攏東南亞國家 ，不過綜觀這些國家計劃推出5G的時間點都少於1年，美國恐怕得加緊腳步、尋找更有力 的策略。 |
| [問卦]想買手機三星和華為哪個好？ | 2019-04-21 | 05:04:02 | https://www.ptt.cc/bbs/Gossiping/M.1555852218.A.48D.html | realtw | Gossiping | 28 | 9 | 5 | 如題 想買一部新手機 目前品牌鎖定在三星和華為 華為聽臺灣人說偷個資 三星則是爆炸風險高 唯一被航空公司拒絕登機的牌子。所以 想買手機 三星和華為 選哪一個 有無八卦 |
| [新聞]政府推動5G陳其邁：提早到年底或明年初 | 2019-04-21 | 05:46:33 | https://www.ptt.cc/bbs/Gossiping/M.1555854755.A.268.html | aaaccccc1 | Gossiping | 18 | 8 | 1 | 1.媒體來源: 中央社。2.記者署名 劉麗榮。3.完整新聞標題: 政府推動5G 陳其邁：提早到年底或明年初。4.完整新聞內文: （中央社記者劉麗榮台北19日電）行政院副院長陳其邁今天表示，行政院推動5G原預計明 年6月建置完成，現在可能提早到今年年底或明年1月，加速推動5G。。各國積極推動5G。交通部目前預公告「第一類電信事業開放業務項目、範圍、時程及家數 一覽表」修正作業草案，預計6月報行政院核定，再由NCC進行相關管理規則修訂、拍賣頻 譜，NCC評估需8到10個月時間，2020上半年完成首波5G釋照。。不過，行政院科技會報辦公室執行秘書蔡志宏日前表示，立法院有要求5G釋照應加速辦理 ，科技會報辦公室已向行政院建議，在可能範圍內加速5G釋照，最後決定由行政院拍板。。陳其邁上午出席「2019 Future Commerce未來商務展」談到行政院推動5G，原本預計明年 6月建置完成，現在可能提早到今年年底或是明年一月，5G應用將加速推動相關產業及整 個商業營運模式發展。。陳其邁致詞時說，政府持續推動「5加2」產業創新計畫，包括人才、法規、資金和實驗場 域的全面性推動，希望讓新創公司和商業更蓬勃發展，未來政府要做好法規環境建立才能 跟得上時代腳步。。陳其邁也花不少時間參觀現場攤位，與業者互動交流，還體驗AR科技，吸引民眾圍觀拍照 。（編輯：黃國倫）1080419 https://imgur.com/8j5PWzD 5.完整新聞連結 (或短網址): https://www.cna.com.tw/news/firstnews/201904190103.aspx 6.備註: |
| [問卦]拿華為旗艦機真的潮的起來嗎？ | 2019-04-21 | 06:23:30 | https://www.ptt.cc/bbs/Gossiping/M.1555856972.A.AC6.html | sdfg014025xx | Gossiping | 4 | 2 | 1 | 聽說廣告打很大 到處有人在吹但銷售量還輸oppo的品牌-華為 到底有誰在拿啊？。連我深藍9.2統一也沒關係的老爸，都覺得花這麼多錢買這牌子超蠢。鄉民身邊真的有拿華為旗艦的朋友嗎？ |
| [新聞]快了…禁華為、聯想？網1句嗆爆蔡政府 | 2019-04-21 | 08:07:07 | https://www.ptt.cc/bbs/Gossiping/M.1555863189.A.74A.html | peterlin495 | Gossiping | 84 | 4 | 64 | 1.媒體來源: 中時。2.記者署名 中時電子報 吳美觀。3.完整新聞標題: 快了…禁華為、聯想？ 網1句嗆爆蔡政府。4.完整新聞內文: 行政院最快3個月後將公布有資安疑慮陸資產品黑名單，禁止各公務機關，據了解，未來禁 用的產品清單可能包括華為、中興通訊、聯想電腦、海康威視等大陸品牌。蔡政府對陸廠採 取強硬約束手段，引發網友熱議，有人狠嗆「乾脆直接宣布戒嚴，不是比較快？」、「iPho ne的在中國大陸製造，有種就禁用！」。行政院長昨核定「各機關對危害國家資通安全產品限制使用原則?，適用對象包括中央、地 方、公立學校、公營事業及行政法人關鍵基礎設施提供者，其中所謂關鍵基礎設施，涵蓋水 資源、能源、通訊傳播、交通、金融、高科技園區、銀行與金融及緊急醫療等項目。。至於被規範的資通商品，包括網路攝影機、無人機、伺服器主機、雲端服務、電信業核心骨 幹網路設備、電腦軟體及防毒軟體、機關委外開發的系統等。。被外界視該規範衝著等大陸品牌而來，行政院發言人Kolas Yotaka昨表示，未提及單一國家 ，是因為有疑慮資通產品及品牌並非只來自中國大陸，這次原則不界定某一國家，以免掛一 漏萬。。Kolas指出，3個月後將公布有疑慮的品牌與產品清單，各機關不得採購及使用危害國家資通 安全的廠商產品。。官員私下透露，華為、中興通訊、聯想電腦、海康威視未來可能列入禁止使用的產品清單。。蔡政府不排除對大陸科技設備祭出強制規範措施，網友回應幾乎一面倒，有人怒嗆，「乾脆 直接宣布戒嚴，不是比較快？」、「要不要禁止台灣企業幫陸資3C廠商代工啊，這政府一整 個腦袋進水式的執政…」、「為了選舉…胡搞…..看來是急了…可憐」。還有人擔憂產業遭殃，直言「若大陸以相同方式回敬，台灣電子業承受得起嗎？別任性了！ 」、「目前生活軟硬體設施，扣除陸資，陸廠，陸研發。光電視就可以全部下架了，手機更 不用說，鬼島準備倒退到原始人嗎？」、「現在哪個3C產品沒陸資的零件？這樣查下去會沒 完沒了，可能連MIT產品都會列入黑名單」。另網友狠批，「iPhone在中國製造，就禁用啊」、「只剩華碩、HTC，但資進黨也討厭HTC」 、「蘋果產品請先自清通通下架，連HTC零件都在大陸生產，以後用飛鴿傳信吧？」。(中時電子報)。#資通產品 #華為 #中興 #聯想電腦 #海康威視。5.完整新聞連結 (或短網址): https://www.chinatimes.com/realtimenews/20190420002043-260410 6.備註: |
| [問卦]華為p30pro傳資料給beian.gov.cn幹嘛？ | 2019-04-21 | 12:50:09 | https://www.ptt.cc/bbs/Gossiping/M.1555880172.A.7A6.html | s8338127 | Gossiping | 50 | 31 | 1 | https://github.com/pe3zx/huawei-block-list reddit 上已經有人討論了，還有教學怎麼block 這些中國政府的ip 這麼優的手機排隊都買不到， 照相超強的手機捏 花錢體驗一下當支畜der港絕也不錯啦 |
對全部文章進行斷句，並儲存斷句結果
- 依據PTT發文習慣進行斷句
- 列出前 10 列斷句後的資料
- 觀察斷句結果
#記錄每篇文章發稿的日期與時間，未來分析情緒用，另外分
post_datetime = post %>%
select(artUrl,artDate,artTime) %>%
arrange(artDate,artTime)
# 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
post_sentences <- strsplit(post$sentence,"[。！；？!\\?;]")
# 將每句句子，與他所屬的文章連結配對起來，整理成一個dataframe
post_sentences <- data.frame(
artUrl = rep(post$artUrl, sapply(post_sentences, length)),
sentence = unlist(post_sentences)
) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
post_sentences$sentence <- as.character(post_sentences$sentence)
post_sentences %>% head(10) %>% kable%>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
scroll_box(height = "300px")文章內容斷詞
- 初始化斷詞器
- 斷詞與整理斷詞結果
- 去除stop word
- 將前出現頻率前 10 大的字詞列出
#載入自訂字典
article_lexicon <- scan(file = "./dict/article_lexicon.txt", what=character(),sep='\n',
encoding='utf-8',fileEncoding='utf-8')
#載入自訂字典(英文)
article_lexicon_en <- scan(file = "./dict/article_lexicon_en.txt", what=character(),sep='\n',
encoding='utf-8',fileEncoding='utf-8')
#載入stop word
stop_words <- scan(file = "./dict/stop_words.txt", what=character(),sep='\n',
encoding='utf-8',fileEncoding='utf-8')## Warning in scan(file = "./dict/stop_words.txt", what = character(), sep =
## "\n", : 輸入連結 './dict/stop_words.txt' 中的輸入不正確#載入negation word
negation_words <- scan(file = "./dict/negation_words.txt",
what=character(),sep=',',
encoding='utf-8',fileEncoding='utf-8')
#去除出現在 stop word 上的negation word
stop_words <- stop_words[!(stop_words %in% c(negation_words))]
#初始化斷詞器
jieba_tokenizer = worker()
new_user_word(jieba_tokenizer, c(article_lexicon,negation_words))## [1] TRUEarticle_tokenizer <- function(t) {
lapply(t, function(x) {
if(nchar(x)>1){
tokens <- segment(x, jieba_tokenizer)
# 去掉字串長度爲1的詞彙
tokens <- tokens[nchar(tokens)>1]
return(tokens)
}
})
}
post_words <- post_sentences %>%
unnest_tokens(word, sentence, token=article_tokenizer) %>%
count(artUrl, word) %>%
rename(count=n)
# 去除非自訂辭庫中出現的英文詞句與數字
tokens_en_delete <- post_words %>%
filter(str_detect(word, regex("[0-9a-zA-Z]"))) %>%
filter(!(word %in% article_lexicon_en))
post_words <- post_words %>%
filter(!word %in% tokens_en_delete$word)
#計算每篇文章的字詞數
total_words <- post_words %>%
group_by(artUrl) %>%
summarize(total = sum(count))
#加入斷詞結果中
post_words <- left_join(post_words, total_words)## Joining, by = "artUrl"# 去除stop word
post_words_no_stopword <- post_words %>%
filter(!word %in% stop_words)
post_words_no_stopword %>% head(10) ## # A tibble: 10 x 4
## artUrl word count total
## <fct> <chr> <int> <int>
## 1 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 5g 4 180
## 2 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 一再 1 180
## 3 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 一事 1 180
## 4 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 下一代 1 180
## 5 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 不受 1 180
## 6 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 中央 2 180
## 7 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 中共 4 180
## 8 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 中國大陸~ 2 180
## 9 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 五眼 3 180
## 10 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57~ 內閣 1 180文章文字雲
- 製作文字統計表
post_words_no_stopword %>%
group_by(word) %>%
summarise(sum=sum(count)) %>%
arrange(desc(sum)) %>%
top_n(10) %>%
ggplot(aes(word, sum)) +
geom_col() +
xlab(NULL) +
ylab("出現次數") +
coord_flip()## Selecting by sum
- 製作WORDCLOUD2文字雲
#找出出現頻率大於50個字，並去除掉華為
post_words_no_stopword %>%
group_by(word) %>%
summarise(sum=sum(count)) %>%
filter(sum >=50 & word !="華為") %>%
wordcloud2::wordcloud2()文字雲中出現像是國家、5G、技術、手機等與中美貿易戰的主要關鍵字，表示多數文章討論的範圍皆圍繞在5G、手機相關議題。
tf-idf分析
- tf-idf分析
post_words_tf_idf <- post_words %>%
bind_tf_idf(word, artUrl, count)
post_words_tf_idf %>%
group_by(artUrl) %>%
top_n(10) %>%
arrange(desc(artUrl))## Selecting by tf_idf## # A tibble: 9,479 x 7
## # Groups: artUrl [849]
## artUrl word count total tf idf tf_idf
## <fct> <chr> <int> <int> <dbl> <dbl> <dbl>
## 1 https://www.ptt.cc/bbs/Gossiping~ 5g 10 273 0.0366 1.43 0.0524
## 2 https://www.ptt.cc/bbs/Gossiping~ 合約 3 273 0.0110 3.49 0.0383
## 3 https://www.ptt.cc/bbs/Gossiping~ 美英 2 273 0.00733 4.95 0.0363
## 4 https://www.ptt.cc/bbs/Gossiping~ 英國 8 273 0.0293 2.05 0.0602
## 5 https://www.ptt.cc/bbs/Gossiping~ 高度 3 273 0.0110 3.97 0.0436
## 6 https://www.ptt.cc/bbs/Gossiping~ 梅伊 2 273 0.00733 5.13 0.0376
## 7 https://www.ptt.cc/bbs/Gossiping~ 第三國~ 2 273 0.00733 4.95 0.0363
## 8 https://www.ptt.cc/bbs/Gossiping~ 會晤 2 273 0.00733 4.95 0.0363
## 9 https://www.ptt.cc/bbs/Gossiping~ 網路 5 273 0.0183 1.95 0.0357
## 10 https://www.ptt.cc/bbs/Gossiping~ 諾基亞~ 3 273 0.0110 3.80 0.0418
## # ... with 9,469 more rows評論資料分析
#載入評論資料
comment<- read_csv("./huawei_articleCommentData.csv")## Parsed with column specification:
## cols(
## artTitle = col_character(),
## artDate = col_date(format = ""),
## artTime = col_time(format = ""),
## artUrl = col_character(),
## artPoster = col_character(),
## artCat = col_character(),
## commentPoster = col_character(),
## commentStatus = col_character(),
## commentDate = col_datetime(format = ""),
## commentContent = col_character()
## )#變更欄位名稱
comment <- rename(comment,cmtPoster = commentPoster , cmtStatus = commentStatus, cmtContent = commentContent)
#取出指定欄位
comment <- comment %>% select(artUrl, cmtPoster, cmtStatus, cmtContent)
comment %>% head(10) ## # A tibble: 10 x 4
## artUrl cmtPoster cmtStatus cmtContent
## <chr> <chr> <chr> <chr>
## 1 https://www.ptt.cc/bbs/G~ arrenwu 推 :CIA已知用火
## 2 https://www.ptt.cc/bbs/G~ GalacticE~ 推 :台灣人的反應：繼續排隊搶購華為P30P。~
## 3 https://www.ptt.cc/bbs/G~ HELLDIVER → :支那所有的企業全都被共產黨操控啊~
## 4 https://www.ptt.cc/bbs/G~ shengyeh 推 :真的是已知用火
## 5 https://www.ptt.cc/bbs/G~ tony0928 推 :大家都知道
## 6 https://www.ptt.cc/bbs/G~ vyjssm → :華為愛作假，我htcu11換了samsungs~
## 7 https://www.ptt.cc/bbs/G~ taiwan009 噓 :結果依舊是沒有任何證據，只是劃唬爛~
## 8 https://www.ptt.cc/bbs/G~ goenitzx → :規模小到中共沒興趣的應該算私人企業了吧~
## 9 https://www.ptt.cc/bbs/G~ taiwan009 → :伊拉克大規模毀滅性武器找到沒？~
## 10 https://www.ptt.cc/bbs/G~ goenitzx → :小雜貨店甚麼的...#發文者人數 532名
length(unique(post$artPoster))## [1] 532#回覆者人數 11405名
length(unique(comment$cmtPoster))## [1] 11405#總參與人數 11666名
allPoster <- c(post$artPoster, comment$cmtPoster)
length(unique(allPoster))## [1] 11666userList <- data.frame(user=unique(allPoster)) %>%
mutate(type=ifelse(user%in%post$artPoster, "poster", "replyer"))
userList %>% head(10) ## user type
## 1 FiveSix911 poster
## 2 ejcj0m poster
## 3 oidioi11 poster
## 4 ororzzz poster
## 5 anti87 poster
## 6 realtw poster
## 7 aaaccccc1 poster
## 8 sdfg014025xx poster
## 9 peterlin495 poster
## 10 s8338127 poster#將回復者與發文者連結在一起
posts_Reviews <- merge(x = post, y = comment, by = "artUrl")
#取出 cmtPoster(回覆者)、artPoster(發文者)、artUrl(文章連結) 三個欄位
link <- posts_Reviews %>%
select(cmtPoster, artPoster, artUrl)
link %>% head(10) ## cmtPoster artPoster
## 1 arrenwu FiveSix911
## 2 GalacticEcho FiveSix911
## 3 HELLDIVER FiveSix911
## 4 shengyeh FiveSix911
## 5 tony0928 FiveSix911
## 6 vyjssm FiveSix911
## 7 taiwan009 FiveSix911
## 8 goenitzx FiveSix911
## 9 taiwan009 FiveSix911
## 10 goenitzx FiveSix911
## artUrl
## 1 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 2 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 3 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 4 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 5 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 6 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 7 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 8 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 9 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html
## 10 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html#建立網路關係
#回覆者→發文者
reviewNetwork <- graph_from_data_frame(d=link, directed=T)
reviewNetwork## IGRAPH dc59752 DN-- 11666 45129 --
## + attr: name (v/c), artUrl (e/c)
## + edges from dc59752 (vertex names):
## [1] arrenwu ->FiveSix911 GalacticEcho->FiveSix911
## [3] HELLDIVER ->FiveSix911 shengyeh ->FiveSix911
## [5] tony0928 ->FiveSix911 vyjssm ->FiveSix911
## [7] taiwan009 ->FiveSix911 goenitzx ->FiveSix911
## [9] taiwan009 ->FiveSix911 goenitzx ->FiveSix911
## [11] taiwan009 ->FiveSix911 XXXXLAY ->FiveSix911
## [13] XXXXLAY ->FiveSix911 peterwu4 ->FiveSix911
## [15] peterwu4 ->FiveSix911 taiwan009 ->FiveSix911
## + ... omitted several edges#畫出網路圖
plot(reviewNetwork)
#把點點的大小和線的粗細調小，並不顯示使用者賬號。
plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,vertex.label=NA)
根據網路圖顯示，我們可以發現多數帳號皆在網路圖中心，而且相當密集，表示討論的議題與文章，主題相當集中。
評論資料分析
#取2019/05/22的評論資料(評論數最多)
posts_Reviews %>% group_by(artDate) %>%
count(.,artDate) %>%
arrange(desc(n))## # A tibble: 44 x 2
## # Groups: artDate [44]
## artDate n
## <date> <int>
## 1 2019-05-22 10371
## 2 2019-05-19 4486
## 3 2019-05-20 4157
## 4 2019-05-23 3426
## 5 2019-05-26 2801
## 6 2019-05-28 2347
## 7 2019-05-25 2095
## 8 2019-05-21 1945
## 9 2019-05-24 1802
## 10 2019-05-17 1746
## # ... with 34 more rows以評論數最多的2019/05/22作為分析
- 根據數回覆數量排序，選擇05/22的文章來進行分析
#05/22共有10371則留言，數量有點多
link_day <- posts_Reviews %>%
filter(artDate=='2019-05-22') %>%
select(cmtPoster, artPoster, artUrl)
link_day %>% head(10)## cmtPoster artPoster
## 1 windwang rook18ies
## 2 lcall rook18ies
## 3 vava5566 rook18ies
## 4 Muqeem rook18ies
## 5 yorkyoung rook18ies
## 6 zxc1234529 rook18ies
## 7 zxcv820421 rook18ies
## 8 neverfly rook18ies
## 9 zxcv820421 rook18ies
## 10 ArSaBuLu rook18ies
## artUrl
## 1 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 2 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 3 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 4 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 5 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 6 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 7 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 8 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 9 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html
## 10 https://www.ptt.cc/bbs/Gossiping/M.1558516650.A.60D.html#篩選出有10則以上回覆數的帳號
count_n_10up <-link_day %>%
group_by(cmtPoster) %>%
count(.,cmtPoster)%>%
arrange(desc(n)) %>%
filter(n >=10)
link_day <- link_day %>% inner_join(. , count_n_10up, by=c('cmtPoster'))
link_day %>% head(10)## cmtPoster artPoster
## 1 deepdish craps
## 2 flavorBZ craps
## 3 flavorBZ craps
## 4 z0953781935 craps
## 5 maesww craps
## 6 boogieman craps
## 7 MW1220 craps
## 8 boogieman craps
## 9 z0953781935 craps
## 10 alexrow craps
## artUrl n
## 1 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 25
## 2 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 36
## 3 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 36
## 4 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 12
## 5 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 11
## 6 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 13
## 7 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 14
## 8 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 13
## 9 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 12
## 10 https://www.ptt.cc/bbs/Gossiping/M.1558519691.A.8F9.html 22filtered_user <- userList %>%
filter(user%in%link_day$cmtPoster | user%in%link_day$artPoster) %>%
arrange(desc(type))
filtered_user %>% head(10)## user type
## 1 jaguars33 replyer
## 2 frozenmoon replyer
## 3 yiersan replyer
## 4 stw0975 replyer
## 5 wulaw5566 replyer
## 6 billionaire replyer
## 7 dog990999 replyer
## 8 notneme159 replyer
## 9 darkbrigher replyer
## 10 seamen replyerset.seed(487)
reviewNetwork <- graph_from_data_frame(d=link_day, v=filtered_user, directed=F)
plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,vertex.label=NA)
set.seed(487)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,vertex.label=NA)
set.seed(487)
# 顯示有超過5個關聯的使用者賬號
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,
vertex.label=ifelse(degree(reviewNetwork) > 10, V(reviewNetwork)$label, NA), vertex.label.ces=.5)
篩選出來的文章中，發文者與回覆者之間的互動相當頻繁，發文者本身也是回覆者，因此可以看出參與討論者相當集中在這次事件上。
對全部評論進行斷句，並儲存斷句結果
- 依據PTT發文習慣進行斷句
- 列出前 10 列斷句後的資料
- 觀察斷句結果
# 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
cmt_sentences <- strsplit(comment$cmtContent,"[。！；？!\\?;]")
# 將每句句子，與他所屬的文章連結配對起來，整理成一個dataframe
cmt_sentences <- data.frame(
artUrl = rep(comment$artUrl, sapply(cmt_sentences, length)),
sentence = unlist(cmt_sentences)
) %>%
filter(!str_detect(sentence, regex("^(\t|\n| )*$")))
cmt_sentences$sentence <- as.character(cmt_sentences$sentence)
cmt_sentences %>% head(10) %>% kable%>%
kable_styling(bootstrap_options = c("striped", "hover")) %>%
scroll_box(height = "300px")| artUrl | sentence |
|---|---|
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :CIA已知用火 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :台灣人的反應：繼續排隊搶購華為P30P |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :支那所有的企業全都被共產黨操控啊 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :真的是已知用火 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :大家都知道 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :華為愛作假，我htcu11換了samsungs10+，沒辦法HTC不爭氣 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :結果依舊是沒有任何證據，只是劃唬爛 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :規模小到中共沒興趣的應該算私人企業了吧 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :伊拉克大規模毀滅性武器找到沒 |
| https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html | :小雜貨店甚麼的… |
針對進行斷詞，計算各詞的字數轉成TIDY格式
#依照自訂字典進行斷詞
jieba_tokenizer = worker()
new_user_word(jieba_tokenizer, c(article_lexicon ))## [1] TRUEcomment_words <- cmt_sentences %>%
unnest_tokens(word, sentence, token=article_tokenizer) %>%
count(artUrl, word) %>%
rename(count=n)
# 去除非自訂辭庫中出現的英文詞句與數字
tokens_en_delete <- comment_words %>%
filter(str_detect(word, regex("[0-9a-zA-Z]"))) %>%
filter(!(word %in% article_lexicon_en))
comment_words <- comment_words %>%
filter(!word %in% tokens_en_delete$word)
#計算每篇文章的字詞數
total_words <- comment_words %>%
group_by(artUrl)
#加入斷詞結果中
comment_words <- left_join(comment_words, total_words)## Joining, by = c("artUrl", "word", "count")comment_words_no_stopword <- comment_words %>%
filter(!word %in% stop_words)
head(comment_words_no_stopword)## # A tibble: 6 x 3
## artUrl word count
## <fct> <chr> <int>
## 1 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html 一堆 2
## 2 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html 人權 2
## 3 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html 大家 1
## 4 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html 大規模 3
## 5 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html 小到 1
## 6 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.html 工人 1定義產生pmi整合資料的函數
pmiBinder = function(pmid,topterm,k){
alldata<- Reduce(rbind, Map(function(n1)
{ ttopic = topterm %>% filter(topic==n1)
#取term1即可，反過來數據是一樣的，也就是A->B = 0.999 ，B->A也是0.999
b = pmid %>% filter(item1 %in% ttopic$term & item2 %in% ttopic$term) %>%
mutate(topic=n1)
return(b)
}, 1:k))
return(alldata)
}透過JIEBAR找出詞的詞性，並從評論過濾出詞性是名詞，角色，動名詞，動詞等
wk=worker(type="tag")
keywords = wk<= comment_words$word
wordNVA = data_frame(word=keywords,type=names(keywords)) %>%
distinct()%>%
filter(type=="n" | type=="nr"| type=="nrt"| type=="vn"
| type=="eng")## Warning: `data_frame()` is deprecated, use `tibble()`.
## This warning is displayed once per session. cmt_tidy = comment_words_no_stopword %>%
inner_join(wordNVA) ## Joining, by = "word" head(cmt_tidy,20)## # A tibble: 20 x 4
## artUrl word count type
## <fct> <chr> <int> <chr>
## 1 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 人權 2 n
## 2 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 大家 1 n
## 3 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 工人 1 n
## 4 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 不爭氣~ 1 n
## 5 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 不值錢~ 1 n
## 6 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 五毛 2 n
## 7 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 公司 1 n
## 8 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 反應 1 vn
## 9 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 手機 2 n
## 10 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 支那 1 nr
## 11 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 市井 1 n
## 12 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 平台 1 n
## 13 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 企業 2 n
## 14 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 伊拉克~ 1 nrt
## 15 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 全球 1 n
## 16 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 全部 1 n
## 17 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 全都 1 n
## 18 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 合理 1 vn
## 19 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 作假 1 n
## 20 https://www.ptt.cc/bbs/Gossiping/M.1555802319.A.A57.h~ 事情 1 n#傳入餐數1:Tidy模式的資料集D2W ，參數2:DTM產生出來的各主題字別的BETA表
#須先計算整份文件的pmi，若cmt_tidy跟word內的字不對稱，會發生錯誤
cmt_pmi_w = pairwise_pmi(cmt_tidy , word, artUrl)
head(cmt_pmi_w,20)## # A tibble: 20 x 3
## item1 item2 pmi
## <chr> <chr> <dbl>
## 1 大家 人權 -0.489
## 2 工人 人權 1.41
## 3 不爭氣 人權 1.41
## 4 不值錢 人權 1.23
## 5 五毛 人權 -0.912
## 6 公司 人權 -0.391
## 7 反應 人權 0.186
## 8 手機 人權 -0.918
## 9 支那 人權 -0.600
## 10 市井 人權 3.02
## 11 平台 人權 0.186
## 12 企業 人權 -0.0453
## 13 伊拉克 人權 1.52
## 14 全球 人權 0.0237
## 15 全部 人權 -0.393
## 16 全都 人權 0.940
## 17 合理 人權 -0.313
## 18 作假 人權 3.02
## 19 事情 人權 0.357
## 20 武器 人權 1.00將評論TIDYTEXT轉成DTM MODE
cmt_dtm <- cmt_tidy %>%
mutate(artId = group_indices(., artUrl))%>%
cast_dtm(artUrl,word, count)
#刪除空白的列
rowTotals <- apply(cmt_dtm , 1, sum) #Find the sum of words in each Document
cmt_dtm <- cmt_dtm[rowTotals> 0, ]
inspect(cmt_dtm)## <<DocumentTermMatrix (documents: 839, terms: 6306)>>
## Non-/sparse entries: 31587/5259147
## Sparsity : 99%
## Maximal term length: 7
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs google 五毛
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 1 1
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 0 6
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 62 3
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 59 7
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 34 9
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 55 30
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 3 7
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 2 3
## https://www.ptt.cc/bbs/Gossiping/M.1558867237.A.E84.html 1 28
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 10 4
## Terms
## Docs 公司 手機 支那
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 15 1 7
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 4 17 32
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 7 54 31
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 3 54 17
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 11 30 27
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 3 14 10
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 4 12 11
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 3 17 6
## https://www.ptt.cc/bbs/Gossiping/M.1558867237.A.E84.html 9 18 6
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 9 0 48
## Terms
## Docs 市場 技術 垃圾
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 1 16 9
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 2 13 4
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 21 1 8
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 16 2 6
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 1 5 0
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 38 0 7
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 12 6 1
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 0 3 10
## https://www.ptt.cc/bbs/Gossiping/M.1558867237.A.E84.html 0 0 7
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 4 4 6
## Terms
## Docs 問題 國家
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 13 3
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 5 4
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 11 4
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 8 1
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 3 7
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 4 2
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 14 6
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 6 3
## https://www.ptt.cc/bbs/Gossiping/M.1558867237.A.E84.html 3 6
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 4 23建立回覆留言的LDA模型
- 將K分成2個種類，設訂Gibbs LDA alpha =50/K+1，delta=0.001
- delta函数，可以看做是Beta函数拓展到K维後的參數，由於建議值的計算公式較複雜所以我們先以0.001設定
#定義主題數
topicnum = 2
cmt_lda <- LDA(cmt_dtm, k =topicnum, method = "Gibbs", control = list(seed =2019,
alpha =16.5, delta= 0.001))
cmt_lda## A LDA_Gibbs topic model with 2 topics.查看\(\phi\) matrix (topic * term)
cmt_topics <- tidytext::tidy(cmt_lda, matrix = "beta") #使用"beta"來取出Phi矩陣。
head(cmt_topics,20)## # A tibble: 20 x 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 人權 0.0000000423
## 2 2 人權 0.000878
## 3 1 大家 0.0000000423
## 4 2 大家 0.0105
## 5 1 工人 0.0000000423
## 6 2 工人 0.000319
## 7 1 不爭氣 0.000211
## 8 2 不爭氣 0.0000000399
## 9 1 不值錢 0.000296
## 10 2 不值錢 0.0000000399
## 11 1 五毛 0.0120
## 12 2 五毛 0.0219
## 13 1 公司 0.0000000423
## 14 2 公司 0.0190
## 15 1 反應 0.0000000423
## 16 2 反應 0.000718
## 17 1 手機 0.0482
## 18 2 手機 0.0000000399
## 19 1 支那 0.0260
## 20 2 支那 0.0368尋找Topic的代表字
#手動移除依些跨主題的字樣
remove_words <- c("華為","中國","美國","不能","不會","根本","大家","一樓","爸爸","五毛","出來","可能","應該","呵呵","知道","起來","不用","沒有","只能","幹嘛")
cmt_topics_re = cmt_topics %>%
filter(! term %in% remove_words)
cmt_top_terms <-cmt_topics_re %>%
group_by(topic) %>%
top_n(20, beta) %>%
ungroup() %>%
arrange(topic, -beta)
cmt_top_terms %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip()+
theme(text = element_text(family = "LiSongPro")) ## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database
去除掉對主題判斷沒有任何關係的字詞後，可以發現topic1都集中在手機市場、手機應用服務的討論內容，而topic2則是集中在5G所衍伸出來的問題。
LDA模型轉社群網路視覺化
- 主題網路圖
#將每篇文章加入主題
cmt_topics_re <- tidy(cmt_lda, matrix="gamma") %>%
group_by(document) %>%
top_n(1, wt=gamma)
posts_Reviews <- merge(x = posts_Reviews, y = cmt_topics_re, by.x = "artUrl", by.y="document")
link_day <- posts_Reviews %>%
filter(artDate=='2019-05-22') %>%
select(cmtPoster, artPoster, artUrl, cmtStatus, topic)
filtered_user <- userList %>%
filter(user%in%link_day$cmtPoster | user%in%link_day$artPoster) %>%
arrange(desc(type))
# 建立網路關係
reviewNetwork <- graph_from_data_frame(d=link_day, v=filtered_user, directed=F)
# 依據使用者身份對點進行上色
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
# 依據回覆發生的文章所對應的主題，對他們的關聯線進行上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$topic == "1", "lightgreen", "palevioletred")
#畫出社群網路圖
set.seed(5431)
plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,
vertex.label=ifelse(degree(reviewNetwork) > 100, V(reviewNetwork)$label, NA), vertex.label.ces=.5)
#加入標示
legend("bottomright", c("poster","replyer"), pch=21,
col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=.8)
legend("topleft", c("topic 1","topic 2"),
col=c("lightgreen","palevioletred"), lty=1, cex=.8)
我們將具有100條以上連接的帳號顯示出來，可以看到主要討論的帳號為何，參與topic1與topic2的討論者都會重複出現，代表這兩個議題都是關注中美貿易戰使用者所關心的話題核心。
- 推虛文網路圖
#清除箭頭符號
link_day <- posts_Reviews %>%
filter(artDate=='2019-05-22', cmtStatus!="→") %>%
select(cmtPoster, artPoster, artUrl, cmtStatus, topic)
#篩選link中有出現的使用者
filtered_user <- userList %>%
filter(user%in%link_day$cmtPoster | user%in%link_day$artPoster) %>%
arrange(desc(type))
#建立網路關係
reviewNetwork <- graph_from_data_frame(d=link_day, v=filtered_user, directed=F)
#依據使用者身份對點進行上色
labels <- degree(reviewNetwork)
V(reviewNetwork)$label <- names(labels)
V(reviewNetwork)$color <- ifelse(V(reviewNetwork)$type=="poster", "gold", "lightblue")
#依據回覆發生的文章所對應的主題，對他們的關聯線進行上色
E(reviewNetwork)$color <- ifelse(E(reviewNetwork)$cmtStatus == "推", "lightgreen", "palevioletred")
#畫出社群網路圖
set.seed(487)
plot(reviewNetwork, vertex.size=2, edge.arrow.size=.2,
vertex.label=ifelse(degree(reviewNetwork) > 100, V(reviewNetwork)$label, NA), vertex.label.ces=.5)
#加入標示
legend("bottomright", c("poster","replyer"), pch=21,
col="#777777", pt.bg=c("gold","lightblue"), pt.cex=1, cex=.8)
legend("topleft", c("推","噓"),
col=c("lightgreen","palevioletred"), lty=1, cex=.8)
若是以堆、噓文來分，可以發現那些使用者帳戶是經常發文或回覆文章的人，其中，透過發文、回覆分辨，則可以看到那些使用者會增加討論或引戰，而這些人對整個社群網路的討論可能具有影響力。
- 產生PMI整合資料 視覺化PMI
#Functinc 會過濾4個種類的前10個代表字的PMI，並且合成一個資料集
cmt_pmi_all = pmiBinder(cmt_pmi_w,cmt_top_terms,topicnum)
head(cmt_pmi_all)## # A tibble: 6 x 4
## item1 item2 pmi topic
## <chr> <chr> <dbl> <int>
## 1 支那 手機 -0.779 1
## 2 全部 手機 -0.589 1
## 3 品牌 手機 -0.397 1
## 4 蘋果 手機 -0.477 1
## 5 小米 手機 -0.475 1
## 6 市場 手機 -0.596 1#sumpmidata=cmt_pmi_all %>% group_by(topic,item1) %>%
# summarise(sumpmi=sum(pmi))
# 視覺化兩個topic的PMI
ggplot(cmt_pmi_all, aes(x=item1,y=pmi, fill = topic)) +
geom_col(show.legend = FALSE) +
facet_wrap(~topic, ncol = 2, scales = "free_x")+
theme(text = element_text(family = "LiSongPro")) ## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database
根據圖表顯示，topic1中提到挑舋、活該、高調等詞皆佔較多正數，因此可以推測出topic1中都是與美國易戰雙方互相牽制有關的討論內容，而topic2則是提到手機市場及應用服務相關的資訊，即Google發布不再支援華為手機應用服務，透過PMI可更了解兩個主題的談論核心話題為何。
話題內的相關性
- 在此我們僅針對TOPIC1 TOPIC2 考慮主題1和主題2之間β差異最大的術語，並過濾β小於千分之一的常用詞
beta_spread <- cmt_topics %>%
filter(topic <=2) %>%
mutate(topic = paste0("topic", topic)) %>%
spread(topic, beta) %>%
filter(topic1 > .0001 | topic2 > .0001 ) %>%
mutate(log_ratio = log2(topic2 / topic1))
beta_spread## # A tibble: 2,303 x 4
## term topic1 topic2 log_ratio
## <chr> <dbl> <dbl> <dbl>
## 1 <U+534E><U+4E3A> 0.0000000423 0.000160 11.9
## 2 amd 0.00199 0.0000000399 -15.6
## 3 android 0.00740 0.0000000399 -17.5
## 4 apple 0.00165 0.0000000399 -15.3
## 5 google 0.0272 0.0000000399 -19.4
## 6 ios 0.00114 0.0000000399 -14.8
## 7 tsmc 0.0000000423 0.00251 15.9
## 8 一家人 0.0000000423 0.000200 12.2
## 9 一家親 0.0000000423 0.00104 14.6
## 10 一帶 0.0000000423 0.000599 13.8
## # ... with 2,293 more rows- 針對topic 1, topic2 進行分析，分析哪些詞彙很常出現在topic1，但很少出現在topic2的詞彙。
#取出log_ratio最高及最低的10個term
cmt_topic_ratio <- rbind(beta_spread %>% top_n(10,wt = log_ratio), beta_spread %>% top_n(-10, log_ratio)) %>%
arrange(log_ratio)
cmt_topic_ratio## # A tibble: 20 x 4
## term topic1 topic2 log_ratio
## <chr> <dbl> <dbl> <dbl>
## 1 手機 0.0482 0.0000000399 -20.2
## 2 google 0.0272 0.0000000399 -19.4
## 3 市場 0.0233 0.0000000399 -19.2
## 4 小米 0.0153 0.0000000399 -18.6
## 5 系統 0.0140 0.0000000399 -18.4
## 6 智障 0.0139 0.0000000399 -18.4
## 7 蘋果 0.0131 0.0000000399 -18.3
## 8 贏家 0.0106 0.0000000399 -18.0
## 9 新聞 0.0103 0.0000000399 -18.0
## 10 幹嘛 0.00960 0.0000000399 -17.9
## 11 科技 0.0000000423 0.00838 17.6
## 12 爸爸 0.0000000423 0.00930 17.7
## 13 大家 0.0000000423 0.0105 17.9
## 14 企業 0.0000000423 0.0122 18.1
## 15 制裁 0.0000000423 0.0128 18.2
## 16 晶片 0.0000000423 0.0134 18.3
## 17 高調 0.0000000423 0.0161 18.5
## 18 公司 0.0000000423 0.0190 18.8
## 19 國家 0.0000000423 0.0198 18.8
## 20 技術 0.0000000423 0.0240 19.1- 視覺化差異
cmt_topic_ratio %>%
ggplot(aes(x = reorder(term, log_ratio), y = log_ratio)) +
geom_bar(stat="identity") +
xlab("Word")+
coord_flip()+
theme(text = element_text(family = "LiSongPro")) ## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database
圖中兩個話題的字詞差異較大，在話題分類上較為明顯，包含手機市場與5G設備的討論，這也是華為在該次事件中最受討論的兩部分，然而我們需要更明確地了解話題是否是明確的。
- 因為要過濾的詞可能太多了，接著我們嘗試透過，計算評論每個詞彙在的tf-idf來限制
#計算每篇文章的字詞數
total_words <- cmt_tidy %>%
group_by(artUrl) %>%
summarize(total = sum(count))
#加入斷詞結果中
cmt_tidy <- left_join(cmt_tidy, total_words)## Joining, by = "artUrl"cmt_tf_idf <- cmt_tidy %>%
bind_tf_idf(word, artUrl, count)
cmt_tf_idf %>%
filter(! word %in% remove_words) %>%
group_by(artUrl) %>%
top_n(10) %>%
arrange(desc(artUrl))## Selecting by tf_idf## # A tibble: 7,927 x 8
## # Groups: artUrl [839]
## artUrl word count type total tf idf tf_idf
## <fct> <chr> <int> <chr> <int> <dbl> <dbl> <dbl>
## 1 https://www.ptt.cc/bbs/Gos~ 工商時報~ 1 n 22 0.0455 6.73 0.306
## 2 https://www.ptt.cc/bbs/Gos~ 汪汪 1 nr 22 0.0455 4.33 0.197
## 3 https://www.ptt.cc/bbs/Gos~ 官員 1 n 22 0.0455 4.43 0.201
## 4 https://www.ptt.cc/bbs/Gos~ 首度 1 n 22 0.0455 6.73 0.306
## 5 https://www.ptt.cc/bbs/Gos~ 麥卡錫 1 nr 22 0.0455 6.73 0.306
## 6 https://www.ptt.cc/bbs/Gos~ 華萊士 1 nr 22 0.0455 6.73 0.306
## 7 https://www.ptt.cc/bbs/Gos~ 電子報 1 n 22 0.0455 6.73 0.306
## 8 https://www.ptt.cc/bbs/Gos~ 樓主 1 n 22 0.0455 5.35 0.243
## 9 https://www.ptt.cc/bbs/Gos~ 標記 1 n 22 0.0455 6.73 0.306
## 10 https://www.ptt.cc/bbs/Gos~ 錯亂 1 n 22 0.0455 5.35 0.243
## # ... with 7,917 more rows- 檢視tf-idf加權值，設定限制建議值(提供過濾字建議的tf-dif參考值，例如：不需要“應該”詞彙，設定tf-idf >0.42)
err = cmt_tf_idf %>% filter(word %in% remove_words) %>%
arrange(desc(tf_idf))
#檢視tf-idf加權值，設定限制建議值
err## # A tibble: 715 x 8
## artUrl word count type total tf idf tf_idf
## <fct> <chr> <int> <chr> <int> <dbl> <dbl> <dbl>
## 1 https://www.ptt.cc/bbs/Gossi~ 一樓 3 n 6 0.5 3.18 1.59
## 2 https://www.ptt.cc/bbs/Gossi~ 一樓 1 n 3 0.333 3.18 1.06
## 3 https://www.ptt.cc/bbs/Gossi~ 大家 1 n 2 0.5 1.61 0.807
## 4 https://www.ptt.cc/bbs/Gossi~ 一樓 1 n 4 0.25 3.18 0.794
## 5 https://www.ptt.cc/bbs/Gossi~ 一樓 2 n 11 0.182 3.18 0.578
## 6 https://www.ptt.cc/bbs/Gossi~ 一樓 100 n 603 0.166 3.18 0.527
## 7 https://www.ptt.cc/bbs/Gossi~ 一樓 1 n 7 0.143 3.18 0.454
## 8 https://www.ptt.cc/bbs/Gossi~ 幹嘛 2 n 8 0.25 1.75 0.437
## 9 https://www.ptt.cc/bbs/Gossi~ 一樓 3 n 22 0.136 3.18 0.433
## 10 https://www.ptt.cc/bbs/Gossi~ 一樓 5 n 40 0.125 3.18 0.397
## # ... with 705 more rows- 透過調整tf_idf、K、alpha、delta來找出同一個TOPIC PMI值正數較多的個數，越多越好，表示主題內歸納越相關
#限制TF_IDF大於0.003
cmt_dtm <- cmt_tf_idf %>%
filter(!word %in% remove_words) %>%
filter(tf_idf > 0.003) %>%
cast_dtm(artUrl,word, count)
#刪除空白的列
rowTotals <- apply(cmt_dtm , 1, sum) #Find the sum of words in each Document
cmt_dtm <- cmt_dtm[rowTotals> 0, ]
inspect(cmt_dtm)## <<DocumentTermMatrix (documents: 839, terms: 6301)>>
## Non-/sparse entries: 30823/5255716
## Sparsity : 99%
## Maximal term length: 7
## Weighting : term frequency (tf)
## Sample :
## Terms
## Docs google 公司
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 0 15
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 0 4
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 62 7
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 59 3
## https://www.ptt.cc/bbs/Gossiping/M.1558312106.A.0F5.html 34 2
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 34 11
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 55 3
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 3 4
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 2 3
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 10 9
## Terms
## Docs 手機 支那 市場
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 0 7 0
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 17 32 2
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 54 31 21
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 54 17 16
## https://www.ptt.cc/bbs/Gossiping/M.1558312106.A.0F5.html 26 28 20
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 30 27 0
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 14 10 38
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 12 11 12
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 17 6 0
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 0 48 4
## Terms
## Docs 技術 垃圾 高調
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 16 9 71
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 13 4 3
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 0 8 3
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 2 6 0
## https://www.ptt.cc/bbs/Gossiping/M.1558312106.A.0F5.html 2 6 0
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 5 0 0
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 0 7 3
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 6 0 3
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 3 10 0
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 4 6 0
## Terms
## Docs 問題 國家
## https://www.ptt.cc/bbs/Gossiping/M.1558136392.A.0A8.html 13 3
## https://www.ptt.cc/bbs/Gossiping/M.1558161474.A.BDB.html 5 4
## https://www.ptt.cc/bbs/Gossiping/M.1558275942.A.1A4.html 11 4
## https://www.ptt.cc/bbs/Gossiping/M.1558307137.A.52D.html 8 0
## https://www.ptt.cc/bbs/Gossiping/M.1558312106.A.0F5.html 0 3
## https://www.ptt.cc/bbs/Gossiping/M.1558351827.A.40C.html 3 7
## https://www.ptt.cc/bbs/Gossiping/M.1558364326.A.EA2.html 4 2
## https://www.ptt.cc/bbs/Gossiping/M.1558535136.A.1E1.html 14 6
## https://www.ptt.cc/bbs/Gossiping/M.1558567918.A.023.html 6 3
## https://www.ptt.cc/bbs/Gossiping/M.1559097546.A.005.html 4 23#定義主題數
topicnum = 4
cmt_lda1 <- LDA(cmt_dtm, k = topicnum, method = "Gibbs", control = list(seed = 883,alpha = 13.5,delta= 0.001))
#取出PHI陣列
cmt_topics1 <- tidytext::tidy(cmt_lda1, matrix = "beta")
cmt_top_terms1 <-cmt_topics1 %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)
cmt_top_terms1 %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip()+
theme(text = element_text(family = "LiSongPro")) ## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database
根據圖表可以推測第一主題為應用服務與手機品牌比較(Google、小米、蘋果、百度)，第二主題為政治相關(支那、大陸、風向)，第三主題為手機設備技術(技術、晶片、設備)，第四主題為中美貿易戰的影響(國家、政府、企業)，我們需要利用PMI值來了解主題的核心內容。
- 四個主題的PMI
#關係應該仍已整份為主cmt_pmi_w，重新依據TOPIC1-2 PMI
cmt_pmi_all1 = pmiBinder(cmt_pmi_w,cmt_top_terms1,topicnum)
#視覺化
ggplot(cmt_pmi_all1, aes(x=item1,y=pmi, fill = topic)) +
geom_col(show.legend = FALSE) +
facet_wrap(~topic, ncol = 2, scales = "free_x")+
theme(text = element_text(family = "LiSongPro")) ## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## font family not found in Windows font database## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x,
## x$y, : font family not found in Windows font database
四個主題分析
- 第一個主題根據PMI算出的正相關的詞彙有“百度”、“系統”、“小米”、“贏家”、“google”，主要在討論google發佈新聞稿對華為禁止android系統的授權，近而在中國內地的小米手機，可能會成為此事件的最大贏家。
- 第二個主題根據PMI算出的正相關的詞彙有“高調”、“制裁”、“總統”，主要在討論對於美國川普總統以高調的方式來制裁華為的手段，普遍網友覺得此行為不妥（白Ｏ、智Ｘ）。
- 第三個主題根據PMI均無大於0，故此主題分類的並不明顯。
- 第四個主題根據PMI算出的正相關的詞彙有“代工”、“技術”、“晶片”、“領先”、“全球”、“設備”、“專利”，主要在討論華為擁有領先全世界的技術跟設備，且在近幾年來華為申請的專利也是全球最多的。
結論
從討論的回覆資料中，可以發現大部分討論的話題皆圍繞在川普發布禁止使用華為相關設備後，華為針對該次事件會如何應變，以及中美貿易戰裡中美雙方的政治角力，其中包含華為掌握5G重要的技術及眾多專利，引起美方不滿，進而導致華為設備無法進入美國，這項議題仍是具有討論熱度。 斷詞結果中常見許多辱罵或歧視的字眼，除了PTT八卦版上的鄉民多是討厭中共，且華為成為第一個中美貿易戰的攻擊目標後，便出現許多辱罵中國、華為的字眼，若是去除政治相關的字詞時，則會出現討論手機使用與華為技術能力的相關議題，這也是與政治話題差異最大的地方。 中美貿易戰對許多國家、企業影響甚大，根據分析結果來說，我們可以了解中美貿易戰中存在的主要討論話題為何，以及話題發展的方向。