# Installing some useful packages 
library(tidyverse)
library(gridExtra)
library(highcharter)
library(magrittr)
library(kableExtra)
library(DT)
library(tm)   # A framework for text mining applications within R.
library(jiebaR)
library(tidytext)
library(widyr)
library(wordcloud)
library(RColorBrewer)

此次分析會用一個實際case演練詞頻分析 (tern-freqency analysis)與關鍵字萃取 (Keydword extraction)

1 Loading dataset

# Loading dataset Youtuber 旅遊議題
Video_info <- read.csv(file = "/Users/linweixiang/R/Text Mining/Dataset/201909_video_info.csv")
Video_info %>% head() # dim() = 315 * 11

此份dataset中各欄位名表

items.id：Youtube 給予該影片的 id
items.snippet.channelTitle：該影片來自哪個 Youtuber
items.snippet.publishedAt：影片上架的時間
items.snippet.title：影片標題
items.snippet.description：影片描述
viewCount：影片的觀看次數
likeCount：影片獲得的喜歡數
dislikeCount：影片獲得的不喜歡數
favoriteCount：影片被加入最愛的次數
commentCount：影片的留言數

從上述dataset中，我們想利用items.snippet.description：影片描述這個欄位的資訊，分析各youtuber在旅遊影片描述中常用的關鍵字有哪些
故在此我們要先對影片描述這個欄位裡面的文字資料做資料整理 (Data wrangling)

# 1. Define remove words 
Remove_symbols <- c("《", "》", "【", "】", "｜", 
                    "(", ")", "®", "\n", "？", 
                    "@", "#", "?", "！", "!") # We want to remove symbols

Remove_words <- c("展瑞", "展榮展瑞", "這群人", "蔡阿嘎", "食尚玩嘎", 
                  "嘎慶君遊台灣", "Joeman", "MaoMaoTV", "Mao去旅遊", "劉沛", 
                  "阿倫", "展榮", "Vlog","遊沛", "咪妃", 
                  "VLOG", "凱琪", "瑀熙", "愛莉莎莎", "晋", 
                  "蔡桃貴", "魚乾", "菜喳", "阿滴英文", "阿倫去旅行", 
                  "阿滴", "的", "你", "我", "他", 
                  "影片", "頻道", "訂閱", "[[:alnum:]]")  # We want to remove specify words 

# 2. Remove words 
Video_info %<>% 
  mutate(video_description = gsub(pattern = paste(Remove_symbols, collapse = "|"), 
                                  replacement = "", 
                                  x = items.snippet.description),
         video_description = gsub(pattern = paste(Remove_words, collapse = "|"), 
                                  replacement = "", 
                                  x = video_description), 
         video_description = removeNumbers(video_description %>% as.character()))
Video_info$video_description[1]

## [1] "下方有完整間台南美食店家資訊喔挖出台南人口袋美食，台南人都吃這個啦哈哈哈► ：://./► ：://./► 主：://./► ：://./► 加好友：://./► ：://./台南人都吃這個：家美食清單. 南園鍋貼 (台南市北區南園街號). 三角窗肉燥飯 (台南市東區裕農路號 後甲圓環). 陳記意麵 (台南市東區中華東路二段巷號). 狸小路 (台南市東區裕學路號). 阿川紅燒土魠魚焿 (台南市中西區海安路一段號). 二牛牛肉湯 (台南市安平區安平路號) .豐藏鰻魚料理 (台南市中西區保安路號). 裕民街無名麵店 (台南市北區裕民街號). 福記肉圓 (台南市中西區府前路一段號). 黃火木冰店 (台南市北區海安路三段號). 二哥炒鱔魚 (台南市北區海安路三段之號). 首璽咖啡 (台南市東區裕農路號). 永林牛肉火鍋綜合料理 (台南市北區東豐路號). 小東路麻辣關東煮 (台南市東區小東路號). 一點刈包 (台南市東區小東路號). 天蠍座燒烤 (台南市東區東寧路號). 老泰羊肉 (台南市中西區青年路號). 林家碗糕 (台南市北區開元路巷號). 阿公阿婆蛋餅 (台南市東區小東路巷號). 開元紅燒𩵚魠魚羹 (台南市北區開元路號). 阿和肉燥飯 (台南市中西區府前路一段號). 小南碗粿 (台南市中西區府前路二段號). 台中楊大腸麵線 (台南市北區開元路-號). 鼎富發 (台南市中西區大德街號). 椿之味 (台南市永康區中正路號)只要+留言，箱微補給飲料，送給除了留言抽獎外，即日起至/到指定通路購買還可參加抽獎，即有機會獲得汗蒸幕旅遊券萬元快去買參加抽獎唷*活動詳情請見活動網站 ...瘋狂小時挑戰賽挖出台南人美食清單這家最好吃聯絡：."

經過上述資料整理，會發現文字資料變得較乾淨了(少了會影響斷詞的標躉符號、還有幾個特定字和數字)，故接下來要執行斷詞

2 斷詞 by jiebaR

接著使用jiebaR這個package 對影片描述進行斷詞

# Initialize a JiebaR worker
wk <- worker(stop_word = jiebaR::STOPPATH) # 斷詞器

# Add customized words
customized_words <- c( "台灣", "Hong Kong", "環球影城", "一日", "陽岱鋼", 
                       "寶可夢", "拉麵", "神級")
new_user_word(worker = wk, words = customized_words)

## [1] TRUE

出現TRUE表特定字已新增成功

# 執行斷詞 並將結果彙整
video_description_df <- tibble(
  channel_title = Video_info$items.snippet.channelTitle, 
  video_id = Video_info$items.id, 
  description = sapply(X = Video_info$video_description, 
                       FUN = function(char){
                         segment(code = char, jiebar = wk) %>% 
                           str_c(., collapse = " ")
  })
)

video_description_df %>% head(3) %>%
  kable(., "html", caption = "斷詞結果") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>%
  footnote("dim() = 315 * 3")

斷詞結果
channel_title	video_id	description
蔡阿嘎	K3aygxGsBSM	下方有完整間台南美食店家資訊喔挖出台南人口袋美食台南人都吃這個啦哈哈哈主加好友台南人都吃這個家美食清單南園鍋貼台南市北區南園街號三角窗肉燥飯台南市東區裕農路號後甲圓環陳記意麵台南市東區中華東路二段巷號狸小路台南市東區裕學路號阿川紅燒土魠魚焿台南市中西區海安路一段號二牛牛肉湯台南市安平區安平路號豐藏鰻魚料理台南市中西區保安路號裕民街無名麵店台南市北區裕民街號福記肉圓台南市中西區府前路一段號黃火木冰店台南市北區海安路三段號二哥炒鱔魚台南市北區海安路三段之號首璽咖啡台南市東區裕農路號永林牛肉火鍋綜合料理台南市北區東豐路號小東路麻辣關東煮台南市東區小東路號一點刈包台南市東區小東路號天蠍座燒烤台南市東區東寧路號老泰羊肉台南市中西區青年路號林家碗糕台南市北區開元路巷號阿公阿婆蛋餅台南市東區小東路巷號開元紅燒魠魚羹台南市北區開元路號阿和肉燥飯台南市中西區府前路一段號小南碗粿台南市中西區府前路二段號台中楊大腸麵線台南市北區開元路號鼎富發台南市中西區大德街號椿之味台南市永康區中正路號只要留言箱微補給飲料送給除了留言抽獎外即日起至到指定通路購買還可參加抽獎即有機會獲得汗蒸幕旅遊券萬元快去買參加抽獎唷活動詳情請見活動網站瘋狂小時挑戰賽挖出台南人美食清單這家最好吃聯絡
蔡阿嘎	TlB-kPG4IMA	留言就抽出位可以獲得從澳門帶回來名產豬肉乾喔咦哪裡怪怪哈哈哈哈主加好友抽獎位送出澳門名產豬肉乾才怪聯絡
蔡阿嘎	8D0DvA07_lc	搶先搶先留言日本環球影城破萬元樣限定商品要送大家主加好友日本環球影城抽獎方式三個有在底下留言留什麼都可以獎品內容會抽出位幸運鄉親每人得到一樣喔柯南爆米花桶名柯南毛毯抱枕名柯南領結變聲器名小小兵爆米花桶名魯邦三世爆米花桶名哈利波特杯組名芝麻街娃娃名小小兵造型餅乾桶名截止日期年月日晚上點官方授權日本環球影城日幣購物券產品連結環球影城期間限定日本環球影城電子門票酷日本快速通關產品連結官方授權入園手環阿倍野展望台門票產品連結聯絡
Note:
dim() = 315 * 3

由上述結果可看出，斷詞結果很成功。接著在text mining 中，我們會傾向對文字資料整理成tidy text的形式，以利後續分析
Note: Tidy text的每一列 (Row)都是一個有意義的詞彙或詞組 (one token per row)。

# 將上述資料整理成tidytext 
# tokenize (符號化) function 
tok99 <- function(t) {
  str_split(string = t, pattern = "[ ]{1,}")
} # tokenize

tidy_description_df <- video_description_df %>% 
  unnest_tokens(tbl = ., output = word, input = description, token = tok99) %>% 
  filter(str_length(word) > 1)  # 選擇詞彙超過兩個字的
tidy_description_df  # # dim() = 25237 * 3

上述資料即是tidytext的形式

3 詞頻分析 (term-freqency analysis)

我們將進行詞頻分析 (term-freqency analysis)，了解同一個 Youtuber 使用字詞的習慣，並視覺化每個 Youtuber 最常使用的字詞。

# 詞頻分析  Count words by channels
channel_words <- tidy_description_df %>% 
  group_by(channel_title, word) %>% 
  dplyr::summarise(word_freq = n()) %>%
  filter(word_freq > 1)

# Visualization 
gg_Term_frequency <- channel_words %>% 
  group_by(channel_title) %>% 
  top_n(n = 5, wt = word_freq) %>% 
  arrange(desc(word_freq)) %>% 
  ggplot(data = ., mapping = aes(x = word, y = word_freq, fill = channel_title)) + 
  geom_col(show.legend = FALSE) +
  facet_wrap(~channel_title, ncol = 2, scales = "free") + 
  coord_flip() +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑"), 
        axis.text.x = element_text(angle = 60)) +
  labs(title = "Term frequency")
gg_Term_frequency

由上述圖表可得各youtuber常用的字詞分佈
Note: 建議在詞頻分析中，選出現次數超過一次的字詞

4 TF-IDF algorithm

Term Frequency - Inverse Document Frequency
- 評估一個詞彙對一個文件重要程度的比率

以 Bag of words 為例

# Create a data table 
l <- 1
for (i in c("1", "2", "t", "T")) {
  name_index <- paste("seq", i, sep = "_")
  tmp_seq <- c(paste0("$n_{", i, ",", c(1,2), "}$"),
               paste0("..."),
               paste0("$n_{", i, ",", "d", "}$"),
               paste0("..."),
               paste0("$n_{", i, ",", "D", "}$")
               ) 
  assign(name_index, tmp_seq)
  l = l + 1
}

bag_words_df <- data.frame(V1 = seq_1, 
                           V2 = seq_2, 
                           V3 = "...", 
                           V4 = seq_t, 
                           V5 = "...", 
                           V6 = seq_T) %>% 
  `rownames<-`(., c("文件1", "文件2", "...", "文件d", "..",
                    "文件D"))
# Visualization table 
bag_words_df %>% 
  kable(., "html", 
        col.names = c("詞彙1", "詞彙2", "...", "詞彙t", "...", 
                      "詞彙T")) %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("$n_{t,d}$:表第t個詞彙出現在文件d的次數")

	詞彙1	詞彙2	…	詞彙t	…	詞彙T
文件1	\(n_{1,1}\)	\(n_{2,1}\)	…	\(n_{t,1}\)	…	\(n_{T,1}\)
文件2	\(n_{1,2}\)	\(n_{2,2}\)	…	\(n_{t,2}\)	…	\(n_{T,2}\)
…	…	…	…	…	…	…
文件d	\(n_{1,d}\)	\(n_{2,d}\)	…	\(n_{t,d}\)	…	\(n_{T,d}\)
..	…	…	…	…	…	…
文件D	\(n_{1,D}\)	\(n_{2,D}\)	…	\(n_{t,D}\)	…	\(n_{T,D}\)
Note:
\(n_{t,d}\):表第t個詞彙出現在文件d的次數

簡介 TF-IDF algorithm 運作原理
term frequency: 詞頻 \[ \begin{align} &tf_{t,d} = \frac{n_{t,d}}{\sum_{i=1}^{T}n_{i,d}}, \quad where \sum_{i=1}^{T}n_{i,d} : 表文件d的總字數 \\ &\rightarrow 表第t個詞彙佔文件d字數的比率，愈高表詞彙t在文件 d中出現愈多次(愈重要) \\ \end{align} \]

Inverse Documnet freqency:逆向文檔比率 \[ \begin{align} &idf_{t} = log_{10} \left( \frac{D}{\sum_{d=1}^{D} I(n_{t,d}>0)} \right) \\ &\ \ \quad = log_{10} \left( \frac{文件總數量}{含有詞彙t的文件數} \right) \\ &\rightarrow 衡量詞彙t的獨特性，愈低表詞彙t愈不重要 \end{align} \]

tf.idf(t,d)
由上述兩個指標，可得tf-idf score，即 \[ \begin{align} tf.idf(t,d) &= tf_{t,d} * idf_{t} \\ &\rightarrow 評估詞彙對文件的重要程度 \end{align} \] 藉由tf-idf score，可得TF-IDF score matrix

TF-IDF score matrix
	詞彙1	詞彙2	…	詞彙t	…	詞彙T
文件1	\(tf.idf_{1,1}\)	\(tf.idf_{2,1}\)	…	\(tf.idf_{t,1}\)	…	\(tf.idf_{T,1}\)
文件2	\(tf.idf_{1,2}\)	\(tf.idf_{2,2}\)	…	\(tf.idf_{t,2}\)	…	\(tf.idf_{T,2}\)
…	…	…	…	…	…	…
文件d	\(tf.idf_{1,d}\)	\(tf.idf_{2,d}\)	…	\(tf.idf_{t,d}\)	…	\(tf.idf_{T,d}\)
..	…	…	…	…	…	…
文件D	\(tf.idf_{1,D}\)	\(tf.idf_{2,D}\)	…	\(tf.idf_{t,D}\)	…	\(tf.idf_{T,D}\)
Note:
\(tf.idf_{t,d}\):表第t個詞彙在文件d的tf-idf score

藉由上述TF-IDF score matrix 去做關鍵字萃取(Keyword extraction)

在R中要使用TF-IDF algorithm，可使用 tidytext package 中的函數 bind_tf_idf 進行 TF-IDF algorithm 與關鍵字萃取(Keydword extraction)。

在這裡，我們把一個 Youtuber 當作一篇文章，了解每一位 Youtuber 的內容重點。

# Using TF-IDF based on channel title 
description_tfidf <- channel_words %>%
  bind_tf_idf(tbl = ., 
              term = word, document = channel_title,
              n = word_freq)

description_tfidf %>% head()

上述表格為TF-IDF algorithm 計算完的結果

接下來視覺畫呈現各Youtuber 在旅遊影片中最常使用的前五名的關鍵字為何

# Visualization TF-IDF algorithm bar charts
gg_TF_IDF <- description_tfidf %>%
  group_by(channel_title) %>% # Group by channel 
  top_n(5, tf_idf) %>%  # select top 5 keywords for each channel
  arrange(desc(tf_idf)) %>% # order by tf-idf
  ggplot(aes(word, tf_idf, fill = channel_title)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~channel_title, ncol = 2, scales = "free") +
  coord_flip() +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑"),
        axis.text.x = element_text(angle = 60, hjust = 1)) + 
  labs(title = "TF-IDF algorithm")
gg_TF_IDF

5 共現分析 (Co-occurence analysis)

共現指的是兩個文字同時出現在同一篇文章中的頻率有多高 (亦是種抓關鍵字的方法)

# Select top 15 words 
top15_words <- tidy_description_df %>% 
  group_by(word) %>% 
  dplyr::summarize(Total_count = n()) %>% 
  filter(str_length(word) > 1) %>% 
  arrange(desc(Total_count)) %>% 
  top_n(15)

## Selecting by Total_count

top15_words

# derive cooccurrence for top 10 frequent words
temp <- tidy_description_df %>% 
  filter(word %in% top15_words$word) 
library(widyr)
description_cooc <- temp %>% 
  pairwise_count(tbl = ., 
                 item = word, feature = video_id, 
                 sort = TRUE, upper = FALSE)
description_cooc %>% head()

由上表格可得知兩兩關鍵字相互出現的頻率。接下來我們可使用熱圖 (Heatmap)去視覺化共現矩陣 (Co-occurence matrix)

# Heatmap
ggplot(data = description_cooc, 
       aes(x = item1, y = item2, fill = n)) +
  geom_tile(color = "white")+
  scale_fill_gradient2(low = "white", high = "red", 
                       name = "Co-occurence") +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑", 
                            size = 14),
        axis.text.x = element_text(angle = 60, hjust = 1))

上圖即Co-occurence matrix 的heat map，可由顏色的深淺得知各文字間的共現性為何

接著，我們可以基於 Co-occurence matrix，建立文字的網絡圖 (Network)。

library(igraph)
library(ggnetwork)
set.seed(1234)
description_cooc %>%
  graph_from_data_frame() %>%
  ggnetwork() %>%
  ggplot(data = ., aes(x = x, y = y, 
                       xend = xend, yend = yend)) +
  geom_edges(aes(size = n, alpha = n), color = "cyan4") +
  geom_nodes(color = "black", size = 8) +
  geom_nodelabel_repel(aes(label = name),
                       color = 'grey50',
                       box.padding = unit(1, "lines"),
                       family = "黑體-繁 中黑") +
  theme_bw() +
  theme(text=element_text(family = "黑體-繁 中黑", 
                          size = 16))

上圖即Co-occurence matrix 的Network，可由線顏色的深淺得知各文字間的共現性為何

6 RAKE (Rapid Automatic Keyword Extraction) algorithm

接著我們要實作RAKE algorithm

# 0. Writing RAKE algorithm
youtuber_names <- tidy_description_df$channel_title %>%
  unique()
name <- youtuber_names[1] # 蔡阿嘎

# 1. Filter channel descriptions
text_data <- tidy_description_df %>%
  filter(channel_title == name) %>% 
  mutate_all(.tbl = ., .funs = as.character)

# 2. Get co-ocurrence matrix based on video_id
description_cooc <- text_data %>% 
  widyr::pairwise_count(tbl = ., 
                        item = word, feature = video_id, 
                        sort = TRUE, upper = FALSE)

description_cooc %>% head()

# 3. Spread to matrix form
description_cooc <- description_cooc %>% 
  spread(data = ., key = item2, value = n) 
row.names(description_cooc) <- description_cooc$item1
description_cooc <- description_cooc %>% select(-item1)
description_cooc %>% head()

# 4. Get word frequency by video_id
description_wf <- text_data %>%
  group_by(word) %>%
  summarise(word_frequency = video_id %>% unique() %>% length())
description_wf %>% head()

# 5. Consolidate textrank results
description_rake <- data.frame(
  channel_title = name,
  word = description_cooc %>% colnames(),
  degree =  colSums(!is.na(description_cooc))
  ) %>%
  inner_join(description_wf)  %>%
  mutate(rake = degree / word_frequency) %>% 
  arrange(desc(rake))

description_rake %>% head()

上述即可得到蔡阿嘎關鍵字Rake 的指標，接下來把此演算法推廣到各youtubers
Note: degree:表此關鍵字跟其他字的連接數

frequency:表此關鍵字出現在幾個影片中

RAKE_scort = \(\frac{degree}{frequency}\)

# Get all youtubers rake result
description_rake <- NULL
# Writing RAKE algorithm
youtuber_names <- tidy_description_df$channel_title %>%
  unique()
for (name in youtuber_names) {
  # 1. Filter channel descriptions
  text_data <- tidy_description_df %>%
    filter(channel_title == name) %>% 
    mutate_all(.tbl = ., .funs = as.character)
  
  # 2. Get co-ocurrence matrix based on video_id
  description_cooc <- text_data %>% 
    widyr::pairwise_count(tbl = ., 
                          item = word, feature = video_id, 
                          sort = TRUE, upper = FALSE)
  
  # 3. Spread to matrix form
  description_cooc <- description_cooc %>% 
    spread(data = ., key = item2, value = n) 
  row.names(description_cooc) <- description_cooc$item1
  description_cooc <- description_cooc %>% 
    select(-item1)
  
  # 4. Get word frequency by video_id
  description_wf <- text_data %>%
    group_by(word) %>%
    summarise(word_frequency = video_id %>% 
                unique %>% length )
  
  # 5. Consolidate textrank results
  description_rake <- bind_rows(
    description_rake,
    data.frame(
      channel_title = name,
      word = description_cooc %>% colnames(),
      degree =  colSums(!is.na(description_cooc))
      ) %>%
      inner_join(description_wf)
    )
}

# plot keywords for each channel
description_rake %<>%
  mutate(rake = degree / word_frequency) %>% 
  filter(word_frequency > 5) 

description_rake%>%
  group_by(channel_title) %>%
  top_n(5, rake) %>% 
  ggplot(data = ., 
         mapping = aes(x = reorder(word, rake), 
                       y = rake, fill = channel_title)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "RAKE") +
  facet_wrap(~ channel_title, ncol = 2, scales = "free") +
  coord_flip() +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑", 
                            size = 14),
        axis.text.x = element_text(angle = 60, hjust = 1))

7 TextRank algorithm

我們引入 textrank packages，並用其中的 textrank_keywords function 建立模型。

library(textrank)
textrank_model <- textrank_keywords(  
  tidy_description_df$word, 
  p = 1/3, # Prevalence 希望有1/3的文章出現過
  ngram_max = 2
  )
textrank_model %>% summary()

##                   Length Class      Mode     
## terms             1532   -none-     character
## pagerank             3   -none-     list     
## keywords             3   data.frame list     
## keywords_by_ngram    3   data.frame list

textrank_model$pagerank$vector %>% 
  round(., 3) %>% head(5) %>% t %>% 
  kable(., "html", caption = "斷詞結果") %>%
  kable_styling(bootstrap_options = "striped", 
                full_width = F) %>%
  footnote("各textrank的分數")

斷詞結果
日本	第一次	可以	享有	優惠
0.022	0.003	0.007	0.001	0.002
Note:
各textrank的分數

上述資訊表此次分析中各關鍵字的textrank的分數

textrank_model$keywords %>% head(5) %>% 
  kable(., "html", caption = "斷詞結果") %>%
  kable_styling(bootstrap_options = "striped", 
                full_width = F)

斷詞結果
keyword	ngram	freq
日本-旅遊	2	111
第一次-可以	2	101
可以-折扣	2	101
享有-優惠	2	89
優惠-實際	2	89

上述資訊表此次分析中各關鍵字中各組合出現的次數
e.g. 日本-旅遊:表日本旅遊出現的次數達到111次

那前述是針對所有 youtuber 建立 textrank 模型的結果，接著我們要針對每一個 youtuber 建立個別的 textrank 模型。

# Executive the textrank for every youtubers 
youtuber_names <- tidy_description_df$channel_title %>% 
  unique()
description_textrank <- NULL
for(name in youtuber_names){
  # Filter channel descriptions
  text_data <- tidy_description_df %>% 
    filter(channel_title %in% c(name))
  # Train text rank model
  textrank_model <- textrank_keywords(
    text_data$word, p = 1/3, ngram_max = 2
  )
  
  # Consolidate textrank results
  description_textrank <- bind_rows(
    description_textrank,
    data.frame(
      channel_title = name,
      word = textrank_model$pagerank$vector %>% names(),
      text_rank = textrank_model$pagerank$vector)
  )
}

# Visualization the top 5 keywords for each channels by textrank 

description_textrank %>%
  arrange(desc(text_rank)) %>%
  group_by(channel_title) %>% 
  top_n(5, text_rank) %>% 
  ungroup() %>%
  ggplot(data = ., 
         mapping = aes(x = word, y = text_rank, 
                       fill = channel_title)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "Text Rank") +
  facet_wrap(~channel_title, ncol = 2, scales = "free") +
  coord_flip() +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑", size = 14),
        axis.text.x = element_text(angle = 60, hjust = 1))

上述圖表即為textrank的視覺化呈現

到目前為止，我們學了各種不同的關鍵字萃取的方式，接下來要講解的是，當關鍵字萃取完後，應該如何做視覺化的呈現，也就是大家很常看到的文字雲

8 文字雲 (word cloud)

要製作文字雲，可以用R中 wordcloud這個package 來製作。
接下來我們要比較三種關鍵字萃取演算法得出的結果

# Define a nice color palette
pal <- RColorBrewer::brewer.pal(n = 8,name = "Dark2") # 顏色主題是Dark2, 8種不同的顏色

# Visualization wordcloud of tf-idf
description_tfidf %>%
  group_by(channel_title) %>%
  top_n(10, tf_idf) %>%
  with(wordcloud(words = word, freq = tf_idf, 
                 random.order = FALSE, max.words = 150,
                 colors = pal[factor(channel_title)],
                 family = "黑體-繁 中黑"))

# Visualization wordcloud of RAKE
description_rake %>% 
  filter(word_frequency > 10) %>% 
  group_by(channel_title) %>%
  top_n(10, rake) %>% 
  with(wordcloud(words = word, freq = rake, 
                 random.order = FALSE, max.words = 150,
                 colors = pal[factor(channel_title)],
                 family = "黑體-繁 中黑"))

# Visualization wordcloud of Text Rank
description_textrank %>%
  group_by(channel_title) %>%
  top_n(10, text_rank) %>%
  with(wordcloud(words = word, freq = text_rank, 
                 random.order = FALSE, max.words = 150,
                 colors = pal[factor(channel_title)],
                 family = "黑體-繁 中黑"))

9 Homework

Description : 請使用「Ptt movie板電影心得」資料集，進行關鍵字萃取，並比較好評 (label = 0) 與差評 (label = 1) 心得文的關鍵字有何不同。

# Loading dataset 
setwd(dir = "/Users/linweixiang/R/Text Mining/Dataset")
movie_df <- read.csv(file = "movie板_電影心得.csv") %>% 
  mutate(Label_name = case_when(
    label %in% c("0") ~ "好評", 
    label %in% c("1") ~ "差評", 
  ), 
  label = Label_name, 
  Label_name = NULL)

movie_df %>% 
  head(3) %>% 
  kable(., "html", caption = "資料呈現") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("dim() = 979 * 4")

資料呈現
label	article_title	content	date
好評	[好雷] 大叔好神騎 25km/h	公路電影人人喜歡看青春少年、喜歡看同學死黨、喜歡看曖昧情侶、喜歡看姐妹相挺、甚至喜歡看爺奶遲暮第二春… 但有人喜歡看四五十歲中年大叔嗎？這聽來還真是市場不正確。不過此片兩位大叔還真帥帥之餘該魯的也沒少甚至有點機車、騎的卻是比我們小50馬力還差的小機車、沒有皮衣沒有安全帽只有兩件喪禮西裝不換洗、炎炎夏日還裸騎闖警察簡直媲美這幾天的德國熱浪裸大叔… 《大叔好神騎》的確很神奇，有三成奇幻電影的味道、儘管電影故事絕對可以是寫實、但那場景怎麼看都是奇幻旅程的格局。我們覺得德國人很正經嗎？Naja，既是也不是，如果我們去德國都是去參加商展談生意、或都去古城鎮觀光古建築，那前者一定是經打細算超理性、後者一定是民風純樸超正經；但若我們走上了三不管的鄉間省道、若趁二月嘉年華或七八月暑假前來，一定大吃一驚不虛此行。 https://i.ytimg.com/vi/dgCyglHFSyk/maxresdefault.jpg 此片去年秋冬之交在德奧上映，也許給他們寒風中一點歡快的溫暖？今年在台暑假前上映倒是更應景，六七月之交正是眾家河谷城鎮的葡萄酒節Weinfest季，暑假很長的德國人已經紛紛出籠休閒了。這現代的暑假和傳統的嘉年華都有種一年四季之外的第五季特質，都是上緊發條按部就班的德國人過完一年後，脫離正軌想想人生到底在哪的時節。第一站，當然就是喝酒跳舞醉醺醺、溫泉打砲破個冰，瘋狂一回醒完腦子與才是朝聖之旅的開始。 https://imgur.com/HHDCX4h 這個聖無關任何宗教聖徒，只關於兩位大叔的童稚夢想，少年十五做過的大夢若沒能一鼓作氣完成它、你這輩子還真有底氣圓任何真正的夢想嗎？於是兩位少年各自踏上人生旅程三十年成為了大叔，儘管一個光鮮亮麗當空中飛人環遊世界、一個固守小鎮家鄉柴米油鹽千年一日，但其實那遠離真實夢想的僵固身體都是一個樣，都早已自認了人生就這樣再也變不來。若是一個人過、或是兩個相濡以沫的人過，說不定這輩子就診這樣到老了；但兩個會在父親喪禮大打出手家醜外揚的兄弟，硬是有機會互相刺激彼此鬆動一點點。 https://imgur.com/bM23MTW 電影從離家闖事業三十年的弟弟 Christian返鄉奔喪開始，這黑森林小鎮等個平交道就等了二十分鐘還錯過喪禮，也許這是個具體而微的人生警訊：你一定要慢下來、側耳傾聽鐵軌的律動、體察這大地正準備帶給你什麼真訊息；至於那些繁文縟節嘛，錯過就錯過有啥大不了，就給老闆罰一回或給哥哥 Georg打一頓，出了口氣就算了。人生旅途上的風景趕不得，是要慢慢欣賞的，速限只能 25 km/h；但人生旅途的開始等不得，一不小心錯過就是三十年、再不小心錯過就是一輩子，只有今晚就出發 https://imgur.com/sPrieKA 兩位大叔長得有點不太像兄弟，但他們的異質互動衝突火花一百分。弟弟 Christian像是拎皮箱的型男商務菁英、哥哥 Georg 像是黑森林裡的 redneck 小鄉民，表面一個前衛開放一個木訥保守？但哥哥的保守枷鎖被弟弟開關一開再也回不去、放浪形骸啥也不怕直線往前衝、甚至一路踢趕著世故無奈的弟弟別再多想做了再說、弟弟再反唇相譏我丟下兒子十五年、你冷落戀人三十年根本五十步笑百步 XD 旅途下來人生最重要的事情是什麼，也許從來就毫不意外，只是漸漸明朗起來。 https://imgur.com/OfmoX7b 不管世俗過的是什麼社會人生，是商務大經理還是森林小鄉民，這種公路電影訴求的總是社會人生之下隱沒的人情，兩兄弟自己又打又抱的基情不在話下，他們逃避三十年終於要面對的人情，則從片頭的爸爸到片末的家庭。爸爸，是逝者已矣的錯過，只是往往做子女的後悔自己不孝時，殊不知爸爸大氣得很早就無私祝福向前看；家庭，則是來者可追的美好，正如這趟不可置信的 25km/h 輕型機車旅行般，當下說了就要出發、拖到明天就表示會再拖一個三十年。 https://imgur.com/oRVS10B 夏日的德國，倒處處是如愛麗絲夢遊仙境的奇幻美感，大叔上路更要把童年的瘋狂目標一個個打勾：要喝到酒吸到毒、要把到妹打到砲、要用屁股炸彈跳水、要推倒一頭睡著的牛、要抬起車頭衝下坡、要吃遍一間希臘餐廳全菜單… 這一切有的尚有可能有的也太天馬行空，但他們赫然發現脫離小小黑森林與小小外派辦公室，這片廣袤德國大地上無其不有只要信步所之信車所彎，這裏有穿越時空的踢踏舞會、有性別翻轉的一夜春宵、有草叢小精靈偷搭便車、有新世紀密教營火晚會、有便宜老子足球三對三、有啤酒花園的致命決勝點、甚至還有森林裡的藍波卡獵逃… https://imgur.com/RwOj1qO 而那波羅的海一泡尿的今生心願已了後，暑假一回結束了，兩位大叔與觀眾們都要收假收心回歸正軌嗎？屬於自己而非隨波逐流的正軌，其實從小就簡單清楚，只是少年沒有完成小騎遊就沒有完成大夢想的底氣，如今總算完成大叔神騎後終能展開新篇章？ https://imgur.com/XPqZ2WQ 兩位大叔 Lars Eidinger Bjarne Mädel，完成了一場沒有哲學辯證缺乏心靈雞湯但滿滿童年夢想與德式傻氣的公路嘉年華，眾家德影中年女星《蘿拉快跑》Franka Potente《帝國毀滅》Alexandra Maria Lara《艾瑪的禮物》Jördis Triebel《顛父人生》Sandra Hüller 都來畫龍點睛激起靈感當個萍水相逢的過客，還有年輕輩的 Jella Hasse今年也推出了屬於她自己搭便車橫越德國的公路電影《Vielmachglas》。夏日德國大地，也許天氣燥熱人心躁動，但唯有躁動才有鬆動，推薦喜愛德式喜劇的、以及覺得人生陷入僵局需鬆動一回的觀眾，暢快欣賞。 https://www.youtube.com/watch?v=WKZ1Z4xNNlIt=11s 現在回想起來真是個屬於大叔的美好年代呀~ 真的看了心情大好	Mon Jul 1 17:42:22 2019
好評	[好雷] 寄生上流：味道	搭配著重新再看了一次近期於中國上映掀起熱潮的《神隱少女》。還記得千尋第一次到湯屋頂端找湯婆婆請求她給予一份謀生的工作時，湯婆婆不屑地說這裡的人手已經夠了，你這麼無能的小鬼，憑什麼要給你工作？但如果你堅持的話，我就把最骯最累的工作派給你，你行嗎？可以嗎？千尋有拒絕的選擇嗎，或者說當她不得不闖入了這一個身而為人是異類的世界之中，白龍請她暫且憋住氣隱藏人的氣味，躲得了一座橋的距離、卻怎麼解決這天生無所適從消除的味道呢？她得奮力的活下去，才有辦法完成這段故事。這和奉俊昊《寄生上流》有著殊途同歸的主題：味道。是一個階級的、種族的，身份的，社會之中多數與少數的，還有自然的，味道是這部電影裡無法藏密而被揭露的線索，同時也是憤怒與無助之中最散逸於所有情節發展之中的關鍵。一個住在地下室失業的家庭，碰巧間進入了全然不同的上流社會家庭，試圖用所有本領消除這貧窮而底層的味道，嘗試在生存本領之間力爭活得更好的慾望，而這慾望卻從來沒有把這味道消除，像是《神隱少女》經典的對白一樣，曾經發生的事情不可能忘記，只是想不起來了。是想不起來，還是不願想起，或不得不跟隨著他們的記憶而生？我們首先試著把《寄生上流》看成一部如同千尋冒險求生的故事，只是這背景來到了當代現實的韓國社會之中，那些住在樓上的人們既沒有奪去人們名字的能力、也沒有做什麼特別壞心傷天害理的事情，甚至就是錢多了看似如同他們口中有了錢人也會善良些的代表，那麼怎麼又會發生悲劇呢？是一場冒險故事，怎麼稱作一部力爭上游的人生？重考了四次經由介紹來到豪宅面試的基宇，把自己的名字換成了凱文（當然也必須假造學歷、家庭背景身份），這場戲是由拉背的手持長鏡頭跟著上樓梯、切換不安焦慮的臉龐，還有些心虛的首次獲得了成功。接著慾望不斷攀伸，妹妹也成了潔西卡，甚至得耍點手段與陰謀才能取得下一階段的目標，所有真與假的事物在此以經變的模糊不清，慢鏡頭華麗的抽離對於寫實抗拒的力量，其實這確實是一部神隱故事，因為慾望交纏的生存意志成為了寄生取代他者的身份問題，他們四人其實以為可以寄生而幻化成什麼。這樣的心意在雷雨交加的夜晚達到了高峰，是他們四人如同這棟房屋的各自角色，坐在客廳將偽裝的面具摘下觀看自然的落地窗景色。實則摘下面具的他們，卻同時被男主人歸來的對談之中提點了味道無所遁從越界的事情，那是個讓人心力交疲的夜晚，即便大雨沖刷著整座城市和地面，住在上面的身份可以享受自以為猥褻的性愛入眠，住在下面的人淋著雨心急焦慮的為家奔憂，這裡的水很特別，代表的不是毀滅重生洪大的水、也不是柔軟情慾流動的水、更非自然時間之河的水，反倒是污穢的、針對滲入地下從馬桶湧出的、還有揭露底層卻沖不掉味道的水。這一場大雨的來到，將奉俊昊以通俗劇類型作為文本的符號全癱上了高峰：不同家庭和社會結構衝突的、寄生假裝和失落揭露的。坐在黑水馬桶上不再是連結網路的欣喜，是隔日雨過天晴交叉剪接各自生活最真實的問題，衝突不斷積累與攀升，直到金司機依舊沒有把味道洗去反而更讓人掩鼻之際，我們回想起了原來昨夜悶不吭聲的眼神之中，我們聞到的不是沈默，而是嗅到了那股味道：是自卑、不甘、心虛、無力與悲傷。味道的散曳毀了這世界，連到了最後貪吃而味覺靈敏的米格魯狗狗都搞不清楚狀況的啃食派對的烤肉一漾，只是想要生存與活命有這麼困難嗎？與此同時，我們想起了那一顆石頭，說是能帶來好運和權力的石頭，讓基宇緊緊黏貼著（需要慰藉與作為捍衛的工具時），卻發現根本只是一顆放到了河流之中，跟大家都差不多的石頭。父親說沒有計劃就不會畏懼失敗，那是不是一個矛盾說詞，如果慾望吞噬的寄託沒有玷汙衝動，如果重來沒有遇見過這樣的比較值，如果大雨不必為這二個家庭做出衝突的符號，這石頭會沾上鮮血嗎？但反過來說，想要尋求陽光的人們，像是不得不搭上電梯找湯婆婆的千尋，被奪走了名字之後努力地努力的要找回來，我們被身份的世界捆綁著的人生，怎麼不會有想好好活下去的衝動呢？他們都是人，卻沒有千尋的美好，尋得姓名之後笑著道別。想起李滄東《燃燒烈愛》同樣以社會階級作出批判的意圖，奉俊昊顯得更殘酷、諷刺，更壓低的詩意的愛能幻想宇宙的真諦，而是一場讓消毒水、地下室與發霉的味道混雜在高級牛排或是派對之中，那是真的，人們都可以是鬼，鬼也是人的慾望的味道，我們都用黑色蓋上了雙眼。	Mon Jul 1 21:15:17 2019
好評	[好雷] 玩具總動員4 - 玩具至高無上的榮耀	以下有雷，玩具總動員4又是個絕妙的皮克斯作品 ~~~~~~~~~~~~~~~~~~~ 我是防雷線 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 《心得解析》 2019 / Toy Story 4 / 玩具總動員4 陪伴主人玩一起享受快樂的時光，是玩具至高無上的榮耀這是胡迪從第1到第4集中半段所貫徹的信念。面對安迪的離開，胡迪一夕之間不知該如何所措。胡迪選擇像個孩子般，執著的想從對邦尼的付出得到對自己信念的認可。在一路上壓抑著自己對此念的疑問，直到遇上了消失已久的牧羊女。有同樣經歷的牧羊女，被主人遺棄後，心灰意冷，決定出外闖蕩。從典雅的蓮蓬裙，換上一身帶有女俠氣息的裝扮，正大大的顯示了牧羊女心裡上的變化。牧羊女雖獨立自主，但從前的傷痛卻也伴隨著他，而胡迪固執地貫徹著所謂玩具的忠誠，是牧羊女展示了胡迪新的出路。兩人相輔相成，在最後選擇離開熟悉的夥伴們，選擇同牧羊女一起生活找尋意義。他會沒事的。我是說邦妮。身為二當家的巴斯這麼說著，他在此集裡深切的練習如何當個好的領導者。最後也很夠義氣的，理解胡迪的選擇，歡送胡迪。胡迪被拋棄了嗎？沒有，我想他不再被遺棄了。全片描述著玩具對於自我價值的認知，似乎有主人的玩具，生命才會完整我們又何嘗不是如此？就像父母對於子女的期望；就像胡迪之於剛誕生的叉奇關於玩具這個身分的認知；就像拚了命的尋找代替自己發聲器的蓋比蓋比。也許，胡迪與牧羊女都已為主人做了夠多。是時候追尋自己想要的價值了。大家好，我們是投影。旅人也許，每個人的一生都是一場電影，電影即是人生。也許，在各種電影裡，你曾漫遊其中探索箇中奧妙，成為一位旅人。在這裡，讓我們成為導遊，引領各位旅人，品味電影，品味人生。喜歡這篇的話，不妨來我們的專頁看看。 https://www.facebook.com/%E6%8A%95%E5%BD%B1%E6%97%85%E4%BA%BA165369114162241/	Mon Jul 1 21:19:41 2019
Note:
dim() = 979 * 4

此份dataset (Ptt movie板電影心得)中各欄位名表

label：表好評或差評
article_title：表該文章的主題名
content：表該文章的內容
date：表該文章的上傳時間

從上述dataset中，我們想利用content：文章內容這個欄位的資訊，分析好評跟差評的評論中常用的關鍵字有哪些

9.1 Data Wrangling

故在此我們要先對content這個欄位裡面的文字資料做資料整理 (Data Wrangling)

# Define some remove symbol
Remove_symbols <- c("《", "》", "【", "】", "｜", 
                    "(", ")", "®", "\n", "？", 
                    "@", "#", "?", "！", "!", 
                    "、", "~", "。", "，", ":",
                    "//", "-", "；", "=", "/", 
                    "%") # We want to remove symbols
# Define some stop words 
Remove_words <- c("電影", "雷", "防雷線", "防雷", "是防雷線",
                  "我是防雷線", "主文分隔線", "心得解析", "心得", "解析",
                  "雷文防雷資訊頁", "雷文", "一個", "他們", "可以", 
                  "因為", "自己", "我們", "沒有", "就是",
                  "最後", "覺得", "一個", "不是", "什麼",
                  "可以", "沒有", "真的", "這部", "就是",
                  "覺得", "只是", "其實", "所以", "這個",
                  "還是", "雖然", "一樣", "只是", "完全",
                  "所以", "知道", "這樣", "然後", "還是",
                  "可能", "甚至", "看到", "喜歡", "開始",
                  "如果", "感覺", "應該", "不過", "已經",
                  "還有", "出來", "之後", "不會", "這麼",
                  "但是", "時候", "這種", "根本", "非常",
                  "怎麼", "到底", "一下", "此片", "這些",
                  "很多", "一部", "來說", "一直", "兩句",
                  "不計", "分為", "藉此", "還會", "做到")
# Executive the remove action 
movie_df %<>% 
  mutate(content = content %>% 
           # Remove Specific symbols
           gsub(pattern = paste(Remove_symbols,
                                collapse = "|"), 
                replacement = "", 
                x = .) %>% 
           #  Remove English and numbers
           str_remove_all(string = .,  
                          pattern = "[A-z0-9]") %>% 
           # Remove Specific words
           gsub(pattern = paste(Remove_words,
                                collapse = "|"), 
                        replacement = "", 
                        x = .) ) 


movie_df %>% 
  head(3) %>% 
  kable(., "html", caption = "資料呈現") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("dim() = 979 * 4")

資料呈現
label	article_title	content	date
好評	[好雷] 大叔好神騎 25km/h	公路人人看青春少年看同學死黨看曖昧情侶看姐妹相挺看爺奶遲暮第二春… 但有人看四五十歲中年大叔嗎這聽來還真是市場不正確兩位大叔還真帥帥之餘該魯的也沒少有點機車騎的卻是比小馬力還差的小機車皮衣安全帽只有兩件喪禮西裝不換洗炎炎夏日還裸騎闖警察簡直媲美這幾天的德國熱浪裸大叔… 大叔好神騎的確很神奇有三成奇幻的味道儘管故事絕對是寫實但那場景看都是奇幻旅程的格局德國人很正經嗎既是也去德國都是去參加商展談生意或都去古城鎮觀光古建築那前者一定是經打細算超理性後者一定是民風純樸超正經但若走上了三不管的鄉間省道若趁二月嘉年華或七八月暑假前來一定大吃一驚不虛此行 … 去年秋冬之交在德奧上映也許給寒風中一點歡快的溫暖今年在台暑假前上映倒是更應景六七月之交正是眾家河谷城鎮的葡萄酒節季暑假很長的德國人紛紛出籠休閒了這現代的暑假和傳統的嘉年華都有種一年四季之外的第五季特質都是上緊發條按部就班的德國人過完一年後脫離正軌想想人生在哪的時節第一站當然喝酒跳舞醉醺醺溫泉打砲破個冰瘋狂一回醒完腦子與才是朝聖之旅的 . 聖無關任何宗教聖徒只關於兩位大叔的童稚夢想少年十五做過的大夢若沒能一鼓作氣完成它你這輩子還真有底氣圓任何真正的夢想嗎於是兩位少年各自踏上人生旅程三十年成為了大叔儘管光鮮亮麗當空中飛人環遊世界固守小鎮家鄉柴米油鹽千年一日但那遠離真實夢想的僵固身體都是樣都早已自認了人生就再也變不來若是人過或是兩個相濡以沫的人過說不定這輩子就診到老了但兩個會在父親喪禮大打出手家醜外揚的兄弟硬是有機會互相刺激彼此鬆動一點點 . 從離家闖事業三十年的弟弟返鄉奔喪這黑森林小鎮等個平交道就等了二十分鐘還錯過喪禮也許這是個具體而微的人生警訊：你一定要慢下來側耳傾聽鐵軌的律動體察這大地正準備帶給你真訊息至於那些繁文縟節嘛錯過就錯過有啥大不了就給老闆罰一回或給哥哥打一頓出了口氣就算了人生旅途上的風景趕不得是要慢慢欣賞的速限只能但人生旅途的等不得一不小心錯過三十年再不小心錯過一輩子只有今晚就出發 . 兩位大叔長得有點不太像兄弟但的異質互動衝突火花一百分弟弟像是拎皮箱的型男商務菁英哥哥像是黑森林裡的小鄉民表面前衛開放木訥保守但哥哥的保守枷鎖被弟弟開關一開再也回不去放浪形骸啥也不怕直線往前衝一路踢趕著世故無奈的弟弟別再多想做了再說弟弟再反唇相譏我丟下兒子十五年你冷落戀人三十年五十步笑百步旅途下來人生最重要的事情是也許從來就毫不意外漸漸明朗起來 . 不管世俗過的是社會人生是商務大經理森林小鄉民公路訴求的總是社會人生之下隱沒的人情兩兄弟又打又抱的基情不在話下逃避三十年終於要面對的人情則從片頭的爸爸到片末的家庭爸爸是逝者已矣的錯過往往做子女的後悔不孝時殊不知爸爸大氣得很早就無私祝福向前看家庭則是來者可追的美好正如這趟不可置信的輕型機車旅行般當下說了就要出發拖到明天就表示會再拖三十年 . 夏日的德國倒處處是如愛麗絲夢遊仙境的奇幻美感大叔上路更要把童年的瘋狂目標個打勾：要喝到酒吸到毒要把到妹打到砲要用屁股炸彈跳水要推倒一頭睡著的牛要抬起車頭衝下坡要吃遍一間希臘餐廳全菜單… 這一切有的尚有有的也太天馬行空但赫然發現脫離小小黑森林與小小外派辦公室這片廣袤德國大地上無其不有只要信步所之信車所彎這裏有穿越時空的踢踏舞會有性別翻轉的一夜春宵有草叢小精靈偷搭便車有新世紀密教營火晚會有便宜老子足球三對三有啤酒花園的致命決勝點森林裡的藍波卡獵逃… . 而那波羅的海一泡尿的今生心願已了後暑假一回結束了兩位大叔與觀眾們都要收假收心回歸正軌嗎屬於而非隨波逐流的正軌從小就簡單清楚少年完成小騎遊就完成大夢想的底氣如今總算完成大叔神騎後終能展開新篇章 . 兩位大叔 ä完成了一場哲學辯證缺乏心靈雞湯但滿滿童年夢想與德式傻氣的公路嘉年華眾家德影中年女星蘿拉快跑帝國毀滅艾瑪的禮物ö 顛父人生 ü 都來畫龍點睛激起靈感當個萍水相逢的過客年輕輩的今年也推出了屬於她搭便車橫越德國的公路夏日德國大地也許天氣燥熱人心躁動但唯有躁動才有鬆動推薦喜愛德式喜劇的以及人生陷入僵局需鬆動一回的觀眾暢快欣賞 ..? 現在回想起來真是個屬於大叔的美好年代呀看了心情大好	Mon Jul 1 17:42:22 2019
好評	[好雷] 寄生上流：味道	搭配著重新再看了一次近期於中國上映掀起熱潮的神隱少女還記得千尋第一次到湯屋頂端找湯婆婆請求她給予一份謀生的工作時湯婆婆不屑地說這裡的人手夠了你無能的小鬼憑要給你工作但你堅持的話我就把最骯最累的工作派給你你行嗎嗎千尋有拒絕的選擇嗎或者說當她不得不闖入了這身而為人是異類的世界之中白龍請她暫且憋住氣隱藏人的氣味躲得了一座橋的距離卻怎麼解決這天生無所適從消除的味道呢她得奮力的活下去才有辦法完成這段故事這和奉俊昊寄生上流有著殊途同歸的主題：味道是階級的種族的身份的社會之中多數與少數的自然的味道是裡無法藏密而被揭露的線索同時也是憤怒與無助之中最散逸於所有情節發展之中的關鍵住在地下室失業的家庭碰巧間進入了全然不同的上流社會家庭試圖用所有本領消除這貧窮而底層的味道嘗試在生存本領之間力爭活得更好的慾望而這慾望卻從來把這味道消除像是神隱少女經典的對白曾經發生的事情不忘記想不起來了是想不起來不願想起或不得不跟隨著的記憶而生首先試著把寄生上流看成如同千尋冒險求生的故事這背景來到了當代現實的韓國社會之中那些住在樓上的人們既奪去人們名字的能力也做特別壞心傷天害理的事情錢多了看似如同口中有了錢人也會善良些的代表那麼又會發生悲劇呢是一場冒險故事稱作力爭上游的人生重考了四次經由介紹來到豪宅面試的基宇把的名字換成了凱文（當然也必須假造學歷家庭背景身份）這場戲是由拉背的手持長鏡頭跟著上樓梯切換不安焦慮的臉龐些心虛的首次獲得了成功接著慾望不斷攀伸妹妹也成了潔西卡得耍點手段與陰謀才能取得下一階段的目標所有真與假的事物在此以經變的模糊不清慢鏡頭華麗的抽離對於寫實抗拒的力量這確實是神隱故事慾望交纏的生存意志成為了寄生取代他者的身份問題四人以為寄生而幻化成的心意在雨交加的夜晚達到了高峰是四人如同這棟房屋的各自角色坐在客廳將偽裝的面具摘下觀看自然的落地窗景色實則摘下面具的卻同時被男主人歸來的對談之中提點了味道無所遁從越界的事情那是個讓人心力交疲的夜晚即便大雨沖刷著整座城市和地面住在上面的身份享受自以為猥褻的性愛入眠住在下面的人淋著雨心急焦慮的為家奔憂這裡的水很特別代表的毀滅重生洪大的水也柔軟情慾流動的水更非自然時間之河的水反倒是污穢的針對滲入地下從馬桶湧出的揭露底層卻沖不掉味道的水這一場大雨的來到將奉俊昊以通俗劇類型作為文本的符號全癱上了高峰：不同家庭和社會結構衝突的寄生假裝和失落揭露的坐在黑水馬桶上不再是連結網路的欣喜是隔日雨過天晴交叉剪接各自生活最真實的問題衝突不斷積累與攀升直到金司機依舊把味道洗去反而更讓人掩鼻之際回想起了原來昨夜悶不吭聲的眼神之中聞到的沈默而是嗅到了那股味道：是自卑不甘心虛無力與悲傷味道的散曳毀了這世界連到了貪吃而味覺靈敏的米格魯狗狗都搞不清楚狀況的啃食派對的烤肉一漾想要生存與活命有困難嗎與此同時想起了那一顆石頭說是能帶來好運和權力的石頭讓基宇緊緊黏貼著（需要慰藉與作為捍衛的工具時）卻發現一顆放到了河流之中跟大家都差不多的石頭父親說計劃就畏懼失敗那是矛盾說詞慾望吞噬的寄託玷汙衝動重來遇見過的比較值大雨不必為這二個家庭做出衝突的符號這石頭會沾上鮮血嗎但反過想要尋求陽光的人們像是不得不搭上電梯找湯婆婆的千尋被奪走了名字之後努力地努力的要找回來被身份的世界捆綁著的人生有想好好活下去的衝動呢都是人卻千尋的美好尋得姓名笑著道別想起李滄東燃燒烈愛同樣以社會階級作出批判的意圖奉俊昊顯得更殘酷諷刺更壓低的詩意的愛能幻想宇宙的真諦而是一場讓消毒水地下室與發霉的味道混雜在高級牛排或是派對之中那是人們都是鬼鬼也是人的慾望的味道都用黑色蓋上了雙眼	Mon Jul 1 21:15:17 2019
好評	[好雷] 玩具總動員4 - 玩具至高無上的榮耀	以下有玩具總動員又是個絕妙的皮克斯作品玩具總動員陪伴主人玩一起享受快樂的時光是玩具至高無上的榮耀這是胡迪從第到第集中半段所貫徹的信念面對安迪的離開胡迪一夕之間不知該如何所措胡迪選擇像個孩子般執著的想從對邦尼的付出得到對信念的認可在一路上壓抑著對此念的疑問直到遇上了消失已久的牧羊女有同樣經歷的牧羊女被主人遺棄後心灰意冷決定出外闖蕩從典雅的蓮蓬裙換上一身帶有女俠氣息的裝扮正大大的顯示了牧羊女心裡上的變化牧羊女雖獨立自主但從前的傷痛卻也伴隨著他而胡迪固執地貫徹著所謂玩具的忠誠是牧羊女展示了胡迪新的出路兩人相輔相成在選擇離開熟悉的夥伴們選擇同牧羊女一起生活找尋意義他會沒事的我是說邦妮身為二當家的巴斯說著他在此集裡深切的練習如何當個好的領導者也很夠義氣的理解胡迪的選擇歡送胡迪胡迪被拋棄了嗎我想他不再被遺棄了全片描述著玩具對於自我價值的認知似乎有主人的玩具生命才會完整又何嘗如此就像父母對於子女的期望就像胡迪之於剛誕生的叉奇關於玩具身分的認知就像拚了命的尋找代替發聲器的蓋比蓋比也許胡迪與牧羊女都已為主人做了夠多是追尋想要的價值了大家好是投影旅人也許每個人的一生都是一場即是人生也許在各種裡你曾漫遊其中探索箇中奧妙成為一位旅人在這裡讓成為導遊引領各位旅人品味品味人生這篇的話不妨來的專頁看看 ..	Mon Jul 1 21:19:41 2019
Note:
dim() = 979 * 4

可由上面結果看出，文字資料大致已清理完畢

9.2 Seting worker by jieba

當文字資料前處理結束後，即可進行斷詞

# Setting worker by jieba
wk <- worker(stop_word = jiebaR::STOPPATH) # 創造斷詞器

# Add customized terms
customized_terms <- c("劉德華", "奉俊昊", "玩具總動員", "神隱少女", "湯婆婆", 
                      "擊殺數", "助攻數", "娃娃鬼", "輔助鬼", "感情線", 
                      "小情小愛",  "心得文", "新手上路", "蜘蛛粉", "哭爆", 
                      "靠譜", "披頭四", "愛情戲", "鋼鐵人", "駭客任務 ", 
                      "片商", "寄生上流", "電流大戰", "從前有個好來塢", "超級英雄", 
                      "蜘蛛人", "天氣之子", "王者天下", "環太平洋", "真愛挑日子", 
                      "紺青之拳", "名偵探柯南", "阿拉丁", "那些年我們一起追的女孩", 
                      "沙贊", "海賊王", "玩命關頭")
new_user_word(wk, customized_terms)

## [1] TRUE

# 執行斷詞 並將結果彙整
movie_df %<>%
  mutate(Jieba_seg =  sapply(X = content, 
                             FUN = function(char){
                               segment(code = char,
                                       jiebar = wk) %>% 
                           str_c(., collapse = " ")
  })) %>% 
  select(., c("label", "article_title", "Jieba_seg")) %>% 
  dplyr::rename(.data = ., "content" = "Jieba_seg")

movie_df %>%  
  head(1) %>% 
  kable(., "html", caption = "斷詞結果") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("dim() = 979 * 4")

斷詞結果
label	article_title	content
好評	[好雷] 大叔好神騎 25km/h	公路人人看青春少年看同學死黨看曖昧情侶看姐妹相挺看爺奶遲暮第二春但有人看四五十歲中年大叔嗎這聽來還真是市場不正確兩位大叔還真帥帥之餘該魯的也沒少有點機車騎的卻是比小馬力還差的小機車皮衣安全帽只有兩件喪禮西裝不換洗炎炎夏日還裸騎闖警察簡直媲美這幾天的德國熱浪裸大叔大叔好神騎的確很神奇有三成奇幻的味道儘管故事絕對是寫實但那場景看都是奇幻旅程的格局德國人很正經嗎既是也去德國都是去參加商展談生意或都去古城鎮觀光古建築那前者一定是經打細算超理性後者一定是民風純樸超正經但若走上了三不管的鄉間省道若趁二月嘉年華或七八月暑假前來一定大吃一驚不虛此行去年秋冬之交在德奧上映也許給寒風中一點歡快的溫暖今年在台暑假前上映倒是更應景六七月之交正是眾家河谷城鎮的葡萄酒節季暑假很長的德國人紛紛出籠休閒了這現代的暑假和傳統的嘉年華都有種一年四季之外的第五季特質都是上緊發條按部就班的德國人過完一年後脫離正軌想想人生在哪的時節第一站當然喝酒跳舞醉醺醺溫泉打砲破個冰瘋狂一回醒完腦子與才是朝聖之旅的聖無關任何宗教聖徒只關於兩位大叔的童稚夢想少年十五做過的大夢若沒能一鼓作氣完成它你這輩子還真有底氣圓任何真正的夢想嗎於是兩位少年各自踏上人生旅程三十年成為了大叔儘管光鮮亮麗當空中飛人環遊世界固守小鎮家鄉柴米油鹽千年一日但那遠離真實夢想的僵固身體都是樣都早已自認了人生就再也變不來若是人過或是兩個相濡以沫的人過說不定這輩子就診到老了但兩個會在父親喪禮大打出手家醜外揚的兄弟硬是有機會互相刺激彼此鬆動一點點從離家闖事業三十年的弟弟返鄉奔喪這黑森林小鎮等個平交道就等了二十分鐘還錯過喪禮也許這是個具體而微的人生警訊你一定要慢下來側耳傾聽鐵軌的律動體察這大地正準備帶給你真訊息至於那些繁文縟節嘛錯過就錯過有啥大不了就給老闆罰一回或給哥哥打一頓出了口氣就算了人生旅途上的風景趕不得是要慢慢欣賞的速限只能但人生旅途的等不得一不小心錯過三十年再不小心錯過一輩子只有今晚就出發兩位大叔長得有點不太像兄弟但的異質互動衝突火花一百分弟弟像是拎皮箱的型男商務菁英哥哥像是黑森林裡的小鄉民表面前衛開放木訥保守但哥哥的保守枷鎖被弟弟開關一開再也回不去放浪形骸啥也不怕直線往前衝一路踢趕著世故無奈的弟弟別再多想做了再說弟弟再反唇相譏我丟下兒子十五年你冷落戀人三十年五十步笑百步旅途下來人生最重要的事情是也許從來就毫不意外漸漸明朗起來不管世俗過的是社會人生是商務大經理森林小鄉民公路訴求的總是社會人生之下隱沒的人情兩兄弟又打又抱的基情不在話下逃避三十年終於要面對的人情則從片頭的爸爸到片末的家庭爸爸是逝者已矣的錯過往往做子女的後悔不孝時殊不知爸爸大氣得很早就無私祝福向前看家庭則是來者可追的美好正如這趟不可置信的輕型機車旅行般當下說了就要出發拖到明天就表示會再拖三十年夏日的德國倒處處是如愛麗絲夢遊仙境的奇幻美感大叔上路更要把童年的瘋狂目標個打勾要喝到酒吸到毒要把到妹打到砲要用屁股炸彈跳水要推倒一頭睡著的牛要抬起車頭衝下坡要吃遍一間希臘餐廳全菜單這一切有的尚有有的也太天馬行空但赫然發現脫離小小黑森林與小小外派辦公室這片廣袤德國大地上無其不有只要信步所之信車所彎這裏有穿越時空的踢踏舞會有性別翻轉的一夜春宵有草叢小精靈偷搭便車有新世紀密教營火晚會有便宜老子足球三對三有啤酒花園的致命決勝點森林裡的藍波卡獵逃而那波羅的海一泡尿的今生心願已了後暑假一回結束了兩位大叔與觀眾們都要收假收心回歸正軌嗎屬於而非隨波逐流的正軌從小就簡單清楚少年完成小騎遊就完成大夢想的底氣如今總算完成大叔神騎後終能展開新篇章兩位大叔完成了一場哲學辯證缺乏心靈雞湯但滿滿童年夢想與德式傻氣的公路嘉年華眾家德影中年女星蘿拉快跑帝國毀滅艾瑪的禮物顛父人生都來畫龍點睛激起靈感當個萍水相逢的過客年輕輩的今年也推出了屬於她搭便車橫越德國的公路夏日德國大地也許天氣燥熱人心躁動但唯有躁動才有鬆動推薦喜愛德式喜劇的以及人生陷入僵局需鬆動一回的觀眾暢快欣賞現在回想起來真是個屬於大叔的美好年代呀看了心情大好
Note:
dim() = 979 * 4

由上述結果可看出，斷詞結果很成功。接著在text mining 中，我們會傾向對文字資料整理成tidy text的形式，以利後續分析

Note: Tidy text的每一列 (Row)都是一個有意義的詞彙或詞組 (one token per row)。

9.3 Analysis

9.3.1 term-frequency analysis

# Term-frequency analysis
tok99 <- function(t){
  str_split(string = t, pattern = "[ ]{1,}")
}  # Tokenize function

tidy_content_df <- movie_df %>%
  unnest_tokens(tbl = ., 
                output = word, input = content, 
                token = tok99) %>%
  filter(str_length(word) > 1) # 選擇詞彙超過兩個字的

tidy_content_df %>% 
  head(5) %>% 
  kable(., "html", caption = "Tokenize") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("dim() = 341818 * 3")

Tokenize
label	article_title	word
好評	[好雷] 大叔好神騎 25km/h	公路
好評	[好雷] 大叔好神騎 25km/h	人人
好評	[好雷] 大叔好神騎 25km/h	青春
好評	[好雷] 大叔好神騎 25km/h	少年
好評	[好雷] 大叔好神騎 25km/h	同學
Note:
dim() = 341818 * 3

上述資料即是tidytext的形式

# 詞頻分析  Count words by label
content_words <- tidy_content_df %>% 
  group_by(label, word) %>% 
  dplyr::summarize(word_freq = n())

# Visualization 
gg_Term_frequency <- content_words %>% 
  group_by(label) %>% 
  top_n(n = 10, wt = word_freq) %>% 
  arrange(desc(word_freq)) %>% 
  ggplot(data = ., mapping = aes(x = word, y = word_freq, fill = label)) + 
  geom_col(show.legend = FALSE) +
  facet_wrap(~label, ncol = 2, scales = "free") + 
  coord_flip() +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑"), 
        axis.text.x = element_text(angle = 60)) +
  labs(title = "Term frequency")
gg_Term_frequency

由詞頻分析可以發現，不論是好評還是差評，最常被討論到的關鍵字均包含觀眾、蜘蛛人、故事、角色、主角。且由上述視覺化結果可知，除了反映資料蒐集當下的熱門電影(蜘蛛人)外，亦可以看出討論的內容常聚焦於電影故事本身

9.3.2 TF-IDF algorithm

在R中要使用TF-IDF algorithm，可使用 tidytext package 中的函數 bind_tf_idf 進行 TF-IDF algorithm 與關鍵字萃取 (Keydword extraction)。

# TF-IDF algorithm
content_tfidf <- content_words %>%
  bind_tf_idf(tbl = ., 
              term = word, document = label, 
              n = word_freq)

content_tfidf %>%
  head(5) %>% 
  kable(., "html", caption = "TF-IDF algorithm") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote("dim() = 41023 * 3")

TF-IDF algorithm
label	word	word_freq	tf	idf	tf_idf
差評	阿巴斯	2	4.14e-05	0.6931472	2.87e-05
差評	阿標	4	8.28e-05	0.6931472	5.74e-05
差評	阿布	2	4.14e-05	0.6931472	2.87e-05
差評	阿布超	2	4.14e-05	0.6931472	2.87e-05
差評	阿飛	2	4.14e-05	0.6931472	2.87e-05
Note:
dim() = 41023 * 3

上述表格為TF-IDF algorithm 計算完的結果

接下來視覺化呈現好評、差評中最常使用的前十名的關鍵字為何

# Visualization TF-IDF algorithm bar charts
gg_TF_IDF <- content_tfidf %>%
  group_by(label) %>% # Group by label 
  top_n(5, tf_idf) %>%  # select top 5 keywords for each channel
  arrange(desc(tf_idf)) %>% # order by tf-idf
  ggplot(aes(word, tf_idf, fill = label)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "tf-idf") +
  facet_wrap(~label, ncol = 2, scales = "free") +
  coord_flip() +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑"),
        axis.text.x = element_text(angle = 60, hjust = 1)) + 
  labs(title = "TF-IDF algorithm")
gg_TF_IDF

從TF-IDF algorithm來看，可看出好評跟差評在關鍵字上的不同，可看出兩邊都有討論到電影中的角色和故事內容，但很明顯可看出，討論的電影不大相同

9.3.3 Co-occurence analysis

共現指的是兩個文字同時出現在同一篇文章中的頻率有多高

# Select top 15 words by Co-occurence analysis
top15_words_goods <- tidy_content_df %>% 
  filter(label %in% c("好評")) %>% 
  group_by(word) %>% 
  dplyr::summarize(Total_count = n()) %>% 
  filter(str_length(word) > 1) %>% 
  arrange(desc(Total_count)) %>% 
  top_n(15)

description_cooc_goods <- tidy_content_df %>% 
  filter(word %in% top15_words_goods$word) %>% 
  widyr::pairwise_count(tbl = ., 
                        item = word, feature = label, 
                        sort = TRUE, upper = FALSE) %>% 
  mutate(label = "好評")

top15_words_bads <- tidy_content_df %>% 
  filter(label %in% c("差評")) %>% 
  group_by(word) %>% 
  dplyr::summarize(Total_count = n()) %>% 
  filter(str_length(word) > 1) %>% 
  arrange(desc(Total_count)) %>% 
  top_n(15)

description_cooc_bads <- tidy_content_df %>% 
  filter(word %in% top15_words_bads$word) %>% 
  widyr::pairwise_count(tbl = ., 
                        item = word, feature = label, 
                        sort = TRUE, upper = FALSE) %>% 
  mutate(label = "差評")

description_cooc <- rbind(description_cooc_bads,
                          description_cooc_goods) %>% 
  select(., c(label, everything())) # dim() = 210 * 4

description_cooc %>% datatable()

由上表格可得知在不同評價(好評、差評)下，兩兩關鍵字相互出現的頻率。接下來我們可使用熱圖 (Heatmap)、神經網絡圖 (Neuro Network)去視覺化共現矩陣 (Co-occurence matrix)

# Visualization of Co-occurence analysis
# Heatmap
gg_cooc_goods <- description_cooc %>% 
  filter(label %in% c("好評")) %>%
  ggplot(data = .,
         aes(x = item1, y = item2, fill = n)) +
  geom_tile(color = "white")+
  scale_fill_gradient2(low = "white", high = "red",
                       name = "Co-occurence") +
  theme_bw() +
  ggtitle(label = "好評") + 
  theme(text = element_text(family = "黑體-繁 中黑", 
                            size = 14),
        axis.text.x = element_text(angle = 90, hjust = 1), 
        legend.position = "none")

gg_cooc_bads <- description_cooc %>% 
  filter(label %in% c("差評")) %>%
  ggplot(data = ., 
         aes(x = item1, y = item2, fill = n)) +
  geom_tile(color = "white")+
  scale_fill_gradient2(low = "white", high = "red",
                       name = "Co-occurence") +
  ggtitle(label = "差評") + 
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑", 
                            size = 14),
        axis.text.x = element_text(angle = 90, hjust = 1), 
        legend.position = "none")

grid.arrange(gg_cooc_goods, gg_cooc_bads, ncol = 2)

# Network plot 
library(igraph)
library(ggnetwork)

set.seed(1234)

gg_NN_goods <- description_cooc %>% 
  filter(label %in% c("好評")) %>%
  graph_from_data_frame() %>%
  ggnetwork() %>%
  ggplot(data = ., aes(x = x, y = y, 
                       xend = xend, yend = yend)) +
  geom_edges(aes(size = n, alpha = n), color = "cyan4") +
  geom_nodes(color = "black", size = 8) +
  geom_nodelabel_repel(aes(label = name),
                       color = 'grey50',
                       box.padding = unit(1, "lines"),
                       family = "黑體-繁 中黑") +
  theme_bw() +
  ggtitle(label = "好評") + 
  theme(text = element_text(family = "黑體-繁 中黑", 
                            size = 16), 
        legend.position = "none")

gg_NN_bads <- description_cooc %>% 
  filter(label %in% c("差評")) %>%
  graph_from_data_frame() %>%
  ggnetwork() %>%
  ggplot(data = ., aes(x = x, y = y, 
                       xend = xend, yend = yend)) +
  geom_edges(aes(size = n, alpha = n), color = "cyan4") +
  geom_nodes(color = "black", size = 8) +
  geom_nodelabel_repel(aes(label = name),
                       color = 'grey50',
                       box.padding = unit(1, "lines"),
                       family = "黑體-繁 中黑") +
  theme_bw() +
  ggtitle(label = "差評") + 
  theme(text = element_text(family = "黑體-繁 中黑", 
                            size = 16), 
        legend.position = "none")

grid.arrange(gg_NN_goods, gg_NN_bads, ncol = 2)

從共線性分析可以發現，在好評與差評所有常出現的詞，兩者之間的關係都很緊密，顯示觀眾在評論時，這些字彙較常一起出現。
有趣的發現是，在差評的部分，絕大多數的關鍵字都是與蜘蛛人(蜘蛛、彼得)有關

9.3.4 RAKE

因電腦效能不佳，若把tidy text 全部資料 (341818筆)丟進模型跑會跑不動，故在此只考慮抓取其中30％的資料做運算

set.seed(2020)
Time_start <- Sys.time()
# Get all label rake result
content_rake <- NULL
# Writing RAKE algorithm
label_names <- tidy_content_df$label %>% unique()
for (name in label_names) {
  # 1. Filter label 
  text_data <- tidy_content_df %>%
    sample_frac(size = 0.3, replace = FALSE) %>% 
    filter(label == name) %>% 
    mutate_all(.tbl = ., .funs = as.character)

  # 2. Get co-ocurrence matrix based on article_title
  content_cooc <- text_data %>% 
    widyr::pairwise_count(tbl = ., 
                          item = word, feature = article_title,
                          sort = TRUE, upper = FALSE)
  
  # 3. Spread to matrix form
  content_cooc %<>% 
    spread(data = ., key = item2, value = n) 
  
  content_cooc %<>% 
    `rownames<-`(., c(content_cooc$item1)) %>% 
    select(-item1)
  
  # 4. Get word frequency by video_id
  content_wf <- text_data %>%
    group_by(word) %>%
    summarise(word_frequency = article_title %>% unique() %>% length())
  
  # 5. Consolidate textrank results
  content_rake <- bind_rows(
    content_rake,
    data.frame(
      label = name,
      word = colnames(content_cooc),
      degree =  colSums(!is.na(content_cooc))) %>%
      inner_join(content_wf)
  )
  }

content_rake <- content_rake %>%
  mutate(rake = degree %>% divide_by(word_frequency) )
Time_stop <- Sys.time()

Spent_time <- Time_stop %>% subtract(Time_start) %>% round(., 2) %>% 
  paste("Spent Time:", ., " Minutes")

content_rake %>% 
  sample_frac(size = 0.2) %>%
  mutate(rake = rake %>% round(., 2)) %>% 
  head(5) %>%
  kable(., "html") %>%
  kable_styling(bootstrap_options = "striped", full_width = F) %>% 
  footnote(Spent_time)

label	word	degree	word_frequency	rake
好評	起碼	262	1	262.00
好評	點到	342	2	171.00
好評	拍手叫好	184	2	92.00
好評	有給	65	1	65.00
好評	破壞	698	12	58.17
Note:
Spent Time: 2.35 Minutes

上述即可得到各label關鍵字Rake的指標

# Plot keywords for each channel
content_rake%>%
  group_by(label) %>%
  top_n(7, rake) %>% 
  ggplot(data = ., 
         mapping = aes(x = reorder(word, rake), 
                       y = rake, fill = label)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = "RAKE") +
  facet_wrap(~ label, ncol = 2, scales = "free") +
  coord_flip() +
  theme_bw() +
  theme(text = element_text(family = "黑體-繁 中黑", 
                            size = 14),
        axis.text.x = element_text(angle = 60, hjust = 1))

可由上述圖形看出，RAKE找出來的關鍵字與TF-IDF 找出來不一樣

9.3.5 TextRank