分析PTT八卦版水庫相關文章之詞彙關係

Ch.0 : 資料取得與載入

1. 資料取得及套件載入

載入的資料是由中山大學管理學院文字分析平台取得，在文件集部分選擇下載原始資料。

資料簡介

本資料內容為將PTT八卦板的文章，自 2020/01/01 到 2021/04/07 為止，透過文字分析平台進行關鍵字[水庫、水情、缺水]搜尋，共得到 645 篇文章。

Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼(Windows系統可將這行註解)

安裝需要的packages

packages = c("readr", "dplyr", "stringr", "jiebaR", "tidytext", "NLP", "readr", "tidyr", "ggplot2", "ggraph", "igraph", "scales", "reshape2", "widyr")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)

載入需要的packages以及資料

require(readr)
require(dplyr)
require(stringr)
require(jiebaR)
require(tidytext)
require(NLP)
require(tidyr)
require(ggplot2)
require(ggraph)
require(igraph)
require(scales)
require(reshape2)
require(widyr)

載入自平台下載下來的資料

water <- read_csv("./ptt_gos_water_articleMetaData.csv") %>% 
  mutate(sentence=gsub("[\n]{2,}", "。", sentence)) %>% 
  mutate(sentence=gsub("\n", "", sentence)) %>% 
  mutate(sentence=gsub("http(s)?[-:\\/A-Za-z0-9\\.]+", " ", 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_double(),
  push = col_double(),
  boo = col_double(),
  sentence = col_character()
)

water

資料欄位

1. artTitle: 文章之標題，須注意不同文章可能會有完全相同的標題。
2. artDate: 文章發佈之日期。
3. artTime: 文章發佈之時間。
4. artUrl: 文章之網址，每篇文章之網址為獨一無二的，可用來辨識相同標題之不同文章。
5. artPoster: 發文者ID。
6. artCat: 版別。
7. commentNum: 回文數。
8. push: 推文數。
9. boo: 噓文數。
10. sentence: 文章原文。

PTT articles example:
https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html

台灣水庫即時水情:
https://water.taiwanstat.com/

移除PTT貼新聞時會出現的格式用字

water <- water %>% 
  mutate(sentence=gsub("媒體來源|記者署名|完整新聞標題|完整新聞內文|完整新聞連結|(或短網址)|備註|備註請放最後面|違者新聞文章刪除", "", sentence))

Ch.1 斷句

將文章原文根據規則進行斷句。

以標點符號進行斷句

sample_data <- water %>% head(2)
# 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
sample_sentences <- strsplit(sample_data$sentence,"[。！；？!?;]{1,}")
# 回傳結果為list of vectors，每個vector的內容為每篇文章的斷句結果
sample_sentences

[[1]]
[1] "魯蛇家鄉最近停水好幾天引起民怨"                                                               
[2] "就查了最近的水情資料"                                                                         
[3] " 發現最近新竹以南水情不是很樂觀"                                                              
[4] "卻沒有中央官員出來呼籲要怎麼解決缺水問題"                                                     
[5] "反觀鳳梨被中國禁止進口， 中央從總統到行政院長各級長官，都站出來呼籲解決鳳梨問題"              
[6] "所以現在臺灣鳳梨比臺灣缺水誰重要"                                                             
[7] "沒有喝水就喝鳳梨汁是不錯的解決方案吧"                                                         
[8] "是否有專板本板並非萬能問板兩則本看板嚴格禁止政治問卦未滿30繁體中文字水桶3個月，嚴重者以鬧板論"

[[2]]
 [1] "新頭殼"                                                                                                                                                                                                                                                            
 [2] "顏得智"                                                                                                                                                                                                                                                            
 [3] "水情告急"                                                                                                                                                                                                                                                          
 [4] "新竹以南7水庫蓄水率陷10%保衛戰 春季雨量展望暫不樂觀"                                                                                                                                                                                                               
 [5] "水情告急"                                                                                                                                                                                                                                                          
 [6] "嘉義、台南地區於2月25日，水情燈號調整為減量供水的橙燈，截止至3月2日早上8時，新竹以南已有7座主要水庫，蓄水率逼近10%，新竹科學園區多間科技大廠也啟用水車載水確保產能，然而，根據中央氣象局上周公布的春季氣候展望，降雨的部分照目前預測來看為偏少到正常，水情仍不樂觀"
 [7] "截止至3月2日早上8時，新竹寶二水庫蓄水量12.9%、苗栗永和山水庫12.8%、苗栗明德水庫11.0%、鯉魚潭水庫15.8%、台中德基水庫12.3%"                                                                                                                                          
 [8] "新竹、苗栗、台中五座提供民生用水、農溉用水、工業用水的水庫，蓄水率皆逐漸逼近10%，此外，霧社水庫蓄水率10%、曾文水庫也僅有15.1%"                                                                                                                                     
 [9] "除蓄水率陷入10%保衛戰的7座水庫外，包含日月潭水庫、湖山水庫、仁義潭水庫、南化水庫、烏山頭水庫等雲、嘉、南、彰、投地區主要水庫，蓄水率大多也來到50%甚至以下"                                                                                                         
[10] "按照中央氣象局2月23日所發布的春季氣候展望，預估未來一季的氣溫接近正常，針對雨量部分，春雨預估為偏少到正常，缺水狀況短期難以立即改善，民眾仍須節約用水"                                                                                                             
[11] " 中南部肥宅動起來節約用水阿"                                                                                                                                                                                                                                       
[12] "  還看路邊一堆人在洗車"                                                                                                                                                                                                                                            
[13] "#首先R20重複用不要水洗"                                                                                                                                                                                                                                            

# unlist會將list中所有的vector展開成一個一維的vector
sentences <- unlist(sample_sentences)
sentences

 [1] "魯蛇家鄉最近停水好幾天引起民怨"                                                                                                                                                                                                                                    
 [2] "就查了最近的水情資料"                                                                                                                                                                                                                                              
 [3] " 發現最近新竹以南水情不是很樂觀"                                                                                                                                                                                                                                   
 [4] "卻沒有中央官員出來呼籲要怎麼解決缺水問題"                                                                                                                                                                                                                          
 [5] "反觀鳳梨被中國禁止進口， 中央從總統到行政院長各級長官，都站出來呼籲解決鳳梨問題"                                                                                                                                                                                   
 [6] "所以現在臺灣鳳梨比臺灣缺水誰重要"                                                                                                                                                                                                                                  
 [7] "沒有喝水就喝鳳梨汁是不錯的解決方案吧"                                                                                                                                                                                                                              
 [8] "是否有專板本板並非萬能問板兩則本看板嚴格禁止政治問卦未滿30繁體中文字水桶3個月，嚴重者以鬧板論"                                                                                                                                                                     
 [9] "新頭殼"                                                                                                                                                                                                                                                            
[10] "顏得智"                                                                                                                                                                                                                                                            
[11] "水情告急"                                                                                                                                                                                                                                                          
[12] "新竹以南7水庫蓄水率陷10%保衛戰 春季雨量展望暫不樂觀"                                                                                                                                                                                                               
[13] "水情告急"                                                                                                                                                                                                                                                          
[14] "嘉義、台南地區於2月25日，水情燈號調整為減量供水的橙燈，截止至3月2日早上8時，新竹以南已有7座主要水庫，蓄水率逼近10%，新竹科學園區多間科技大廠也啟用水車載水確保產能，然而，根據中央氣象局上周公布的春季氣候展望，降雨的部分照目前預測來看為偏少到正常，水情仍不樂觀"
[15] "截止至3月2日早上8時，新竹寶二水庫蓄水量12.9%、苗栗永和山水庫12.8%、苗栗明德水庫11.0%、鯉魚潭水庫15.8%、台中德基水庫12.3%"                                                                                                                                          
[16] "新竹、苗栗、台中五座提供民生用水、農溉用水、工業用水的水庫，蓄水率皆逐漸逼近10%，此外，霧社水庫蓄水率10%、曾文水庫也僅有15.1%"                                                                                                                                     
[17] "除蓄水率陷入10%保衛戰的7座水庫外，包含日月潭水庫、湖山水庫、仁義潭水庫、南化水庫、烏山頭水庫等雲、嘉、南、彰、投地區主要水庫，蓄水率大多也來到50%甚至以下"                                                                                                         
[18] "按照中央氣象局2月23日所發布的春季氣候展望，預估未來一季的氣溫接近正常，針對雨量部分，春雨預估為偏少到正常，缺水狀況短期難以立即改善，民眾仍須節約用水"                                                                                                             
[19] " 中南部肥宅動起來節約用水阿"                                                                                                                                                                                                                                       
[20] "  還看路邊一堆人在洗車"                                                                                                                                                                                                                                            
[21] "#首先R20重複用不要水洗"                                                                                                                                                                                                                                            

但在unlist後我們就沒辦法判別每個句子是出自於哪篇文章了，
因此需要一個方法在unlist的同時仍能夠保留句子是屬於哪篇文章

rep function

# rep(x, times = 1, length.out = NA, each = 1)
# 當給定兩個vector長度相同時，rep function會自動對齊兩個vector的值。
# 前面的vector決定要重複的值
# 後面的vector則決定要重複的次數
# ex.
rep(c("Social", "Media"), c(2,5))

[1] "Social" "Social" "Media"  "Media"  "Media"  "Media"  "Media" 

# rep function會自動對齊兩個vector，
# "Social" 會重複2次，"Media"會重複5次

# 原本資料的artUrl
sample_data$artUrl

[1] "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html" "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"

# 回傳每篇文章的斷句後，包含了幾個句（vector的長度）
sapply(sample_sentences, length)

[1]  8 13

# 使用rep去配對原本資料的artUrl以及sapply的回傳（每篇文章包含了幾個句）
# 產生的長度會與 unlist(sample_sentences) 的長度一樣，
# 兩邊join起來就可以新增一個欄位代表每個句子來自哪篇文章
rep(sample_data$artUrl, sapply(sample_sentences, length))

 [1] "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html" "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html"
 [3] "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html" "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html"
 [5] "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html" "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html"
 [7] "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html" "https://www.ptt.cc/bbs/Gossiping/M.1614606334.A.2DD.html"
 [9] "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html" "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"
[11] "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html" "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"
[13] "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html" "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"
[15] "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html" "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"
[17] "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html" "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"
[19] "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html" "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"
[21] "https://www.ptt.cc/bbs/Gossiping/M.1614654780.A.7C6.html"

data.frame(artUrl=rep(sample_data$artUrl, sapply(sample_sentences, length)),
           sentences = unlist(sample_sentences))

對全部的文章進行斷句，並儲存結果

# 以全形或半形 驚歎號、問號、分號 以及 全形句號 爲依據進行斷句
water_sentences <- strsplit(water$sentence,"[。！；？!?;]")

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

water_sentences$sentence <- as.character(water_sentences$sentence)

water_sentences

Ch2. 斷詞

1.初始化斷詞器

# 使用默認參數初始化一個斷詞引擎
# 先不使用任何的字典和停用詞
jieba_tokenizer = worker()

chi_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      # 去掉字串長度爲1的詞彙
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

2.斷詞與整理斷詞結果

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

Ch3. TF-IDF

1. 計算每篇文章的詞數

total_words <- water_words %>% 
  group_by(artUrl) %>% 
  summarize(total = sum(n))

`summarise()` ungrouping output (override with `.groups` argument)

total_words

2. 合併需要的資料欄位

# 合併 mask_words（每個詞彙在每個文章中出現的次數）
# 與 total_words（每篇文章的詞數）
# 新增各個詞彙在所有詞彙中的總數欄位
water_words <- left_join(water_words, total_words)

Joining, by = "artUrl"

water_words

3. 計算 tf-idf 值

# 以每篇文章爲單位，計算每個詞彙的 tf-idf 值
water_words_tf_idf <- water_words %>%
  bind_tf_idf(word, artUrl, n)
water_words_tf_idf

檢視結果

# 選出每篇文章，tf-idf值最大的五個詞
water_words_tf_idf %>% 
  group_by(artUrl) %>%
  slice_max(tf_idf, n=5) %>%
  arrange(desc(artUrl))

計算整個文集中較常 tf-idf 值高的字

# 從每篇文章挑選出tf-idf最大的十個詞，
# 並計算每個詞被選中的次數
water_words_tf_idf %>% 
  group_by(artUrl) %>%
  slice_max(tf_idf, n=10) %>%
  ungroup() %>%
  count(word, sort=TRUE)

Ch4. 透過結巴斷詞與N-gram幫助建立字典

jiebar and ngrams

# 使用結巴斷詞，並搭配NLP packages中的 ngrams function
# e.g.
tokens <- segment("中山資管全國第一", jieba_tokenizer)
tokens

[1] "中山" "資管" "全國" "第一"

bigram <- ngrams(tokens, 2)
bigram

[[1]]
[1] "中山" "資管"

[[2]]
[1] "資管" "全國"

[[3]]
[1] "全國" "第一"

# Combine each bigrams into a single string, with the " " as the seperater.
bigram <- lapply(bigram, paste, collapse = " ")
unlist(bigram)

[1] "中山 資管" "資管 全國" "全國 第一"

Bigram

bigram function

jieba_tokenizer = worker()

# unnest_tokens 使用的bigram分詞函數
# Input: a character vector
# Output: a list of character vectors of the same length
jieba_bigram <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      bigram<- ngrams(tokens, 2)
      bigram <- lapply(bigram, paste, collapse = " ")
      unlist(bigram)
    }
  })
}

jieba_bigram(c("中山資管全國第一", "我今天晚餐吃水餃"))

[[1]]
[1] "中山 資管" "資管 全國" "全國 第一"

[[2]]
[1] "我 今天"   "今天 晚餐" "晚餐 吃"   "吃 水餃"  

執行bigram分詞

water_bigram <- water %>%
  unnest_tokens(bigram, sentence, token = jieba_bigram)
water_bigram

統計最常出現的bigram組合

# 清除包含英文或數字的bigram組合
# 計算每個組合出現的次數
water_bigram %>%
  filter(!str_detect(bigram, regex("[0-9a-zA-Z]"))) %>%
  count(bigram, sort = TRUE)

Trigram

trigram function

jieba_trigram <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      ngram<- ngrams(unlist(tokens), 3)
      ngram <- lapply(ngram, paste, collapse = " ")
      unlist(ngram)
    }
  })
}

jieba_trigram(c("中山資管全國第一", "我今天晚餐吃水餃"))

[[1]]
[1] "中山 資管 全國" "資管 全國 第一"

[[2]]
[1] "我 今天 晚餐" "今天 晚餐 吃" "晚餐 吃 水餃"

執行trigram分詞

water_trigram <- water %>%
  unnest_tokens(ngrams, sentence, token = jieba_trigram)
water_trigram %>%
  filter(!str_detect(ngrams, regex("[0-9a-zA-Z]"))) %>%
  count(ngrams, sort = TRUE)

bigram和trigram的結果可以發現有很多包含stopwords的組合，所以我們接著將stopwords清除再看看有什麼新組合

Remove stop words

載入stop words字典

# load stop words
stop_words <- scan(file = "./dict/stop_words.txt", what=character(),sep='\n', 
                   encoding='utf-8',fileEncoding='utf-8')

Read 1211 items

Remove the stopwords in bigram

water_bigram %>%
  filter(!str_detect(bigram, regex("[0-9a-zA-Z]"))) %>%
  separate(bigram, c("word1", "word2"), sep = " ") %>% 
  filter(!(word1 %in% stop_words), !(word2 %in% stop_words)) %>%
  count(word1, word2, sort = TRUE) %>%
  unite_("bigram", c("word1","word2"), sep=" ")

Remove the stopwords in trigram

water_trigram %>%
  filter(!str_detect(ngrams, regex("[0-9a-zA-Z]"))) %>%
  separate(ngrams, c("word1", "word2", "word3"), sep = " ") %>% 
  filter(!(word1 %in% stop_words), !(word2 %in% stop_words), !(word3 %in% stop_words)) %>%
  count(word1, word2, word3, sort = TRUE) %>%
  unite_("ngrams", c("word1", "word2", "word3"), sep=" ")

從上面的 bigram 和 trigram 的結果中，我們可以看到有些字應該被組合在一起，我們以此來建立更好的斷詞字典。
我們將詞彙整理好存在 dict 文件夾中的 mask_lexicon.txt 中。

Ch5. 使用自建字典

載入自建字典

# load mask_lexicon
water_lexicon <- scan(file = "./dict/water_lexicon.txt", what=character(),sep='\n', 
                   encoding='utf-8',fileEncoding='utf-8',quiet = T)
# 自建水情相關字典
water_lexicon

 [1] "水利署"       "蓄水率"       "減壓供水"     "海水淡化廠"   "海水淡化"     "台中"         "柯文哲"       "超前部署"    
 [9] "民生用水"     "農業用水"     "北水南送"     "美濃水庫"     "南化水庫"     "阿公店水庫"   "烏山頭水庫"   "永和山水庫"  
[17] "鯉魚潭水庫"   "南區水資源局" "生態教育園區" "人工增雨"     "東北季風"     "自由時報"    

使用新字典建立斷詞器

jieba_tokenizer = worker()

# 使用疫情相關字典重新斷詞
new_user_word(jieba_tokenizer, c(water_lexicon))

[1] TRUE

chi_tokenizer <- function(t) {
  lapply(t, function(x) {
    if(nchar(x)>1){
      tokens <- segment(x, jieba_tokenizer)
      tokens <- tokens[!tokens %in% stop_words]
      # 去掉字串長度爲1的詞彙
      tokens <- tokens[nchar(tokens)>1]
      return(tokens)
    }
  })
}

Ch6. Word Correlation

使用自建辭典進行斷詞與計算

# 剛才的斷詞結果沒有使用新增的辭典，因此我們重新進行斷詞，再計算各詞彙在各文章中出現的次數
water_words <- water_sentences %>%
  unnest_tokens(word, sentence, token=chi_tokenizer) %>%
  filter(!str_detect(word, regex("[0-9a-zA-Z]"))) %>%
  count(artUrl, word, sort = TRUE)
water_words

計算兩個詞彙同時出現的總次數

# 過濾掉三個關鍵字"缺水", "水庫", "水情"
word_pairs <- water_words %>%
  pairwise_count(word, artUrl, sort = TRUE) %>% 
  filter(!item1 %in% c("缺水", "水庫", "水情") & !item2 %in% c("缺水", "水庫", "水情"))

word_pairs

計算兩個詞彙間的相關性

word_cors <- water_words %>%
  group_by(word) %>%
  filter(n() >= 10) %>%
  pairwise_cor(word, artUrl, sort = TRUE)

word_cors

視覺化

找出與 “石門水庫” “曾文水庫” 這兩個水庫相關性最高的 15 個詞彙

word_cors %>%
  filter(item1 %in% c("石門水庫", "曾文水庫")) %>%
  group_by(item1) %>%
  top_n(15) %>%
  ungroup() %>%
  mutate(item2 = reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation)) +
  geom_bar(stat = "identity") +
  facet_wrap(~ item1, scales = "free") +
  coord_flip()+ 
  theme(text = element_text(family = "Heiti TC Light")) #加入中文字型設定，避免中文字顯示錯誤。

Selecting by correlation

使用詞彙關係圖畫出相關性大於0.5的組合

set.seed(2020)

word_cors %>%
  filter(correlation > 0.5) %>%
  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 = "Heiti TC Light") + #加入中文字型設定，避免中文字顯示錯誤。
  theme_void()

使用詞彙關係圖畫出相關性大於0.6的組合

set.seed(2020)

word_cors %>%
  filter(correlation > 0.6) %>%
  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 = "Heiti TC Light") +
  theme_void()

移除不需要的字

# 設定幾個詞做爲seed words
seed_words <- c("看板", "中央社", "時報")
# 設定threshold爲0.6
threshold <- 0.6
# 跟seed words相關性高於threshold的詞彙會被加入移除列表中
remove_words <- word_cors %>%
                filter((item1 %in% seed_words|item2 %in% seed_words), correlation>threshold) %>%
                .$item1 %>%
                unique()
remove_words

[1] "日電"   "中央社" "編輯"   "問卦"   "嚴格"   "看板"   "禁止"   "水桶"  

使用詞彙關係圖畫出相關性大於0.6的組合

# 清除存在這些詞彙的組合
word_cors_new <- word_cors %>%
                filter(!(item1 %in% remove_words|item2 %in% remove_words))

word_cors_new %>%
  filter(correlation > 0.6) %>%
  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 = "Heiti TC Light") +
  theme_void()