---
GA: UA-159972578-2
---
###### tags: `R` `Data Processing` `資料前處理` `Regex` `正則表達式` `文字分析` `Text Mining` `情緒分析` `Sentiment Analysis`
# Sympsons(Chinese)_Sentiment Analysis
Reference: [Text Mining Ebook](https://www.tidytextmining.com)
看code完整執行結果: [Rpubs Ver.](https://rpubs.com/RitaTang/588732)
# Data介紹
+ Data Source: [辛普森一家 字幕庫](http://m.proxypy.org/p?q=bG10aC40NjgwNS9zYnVzL2FsLnVrdW1pei53d3cvLzpwdHRo%0A)
+ 第31季第12集~第16集(共5集)
+ 中英皆有(此例用的是中文繁體字幕)
## 斷詞系統
+ Jieba(結巴)
## 情緒字典
+ 中文: LIWC(本例使用)
# 文本探索
## 系統參數設定
```{r}
Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼
```
## 讀取資料
```{r warning=FALSE, message=FALSE, cache=FALSE, error=FALSE}
pacman::p_load(tidytext, jiebaR, tidyverse, stringr, wordcloud2, wordcloud, scales, reshape2)
simps <- read_file("./s31.txt")
simps_e <- read_file("./s31_e.txt")
simps = gsub("[0-9]+", "", simps) # 字幕檔會有太多時間戳記
```
## 文字前處理
### 初始化斷詞引擎
```{r}
# 直接下worker()即可,這裡則使用自訂字典和停用字
jieba_tokenizer = worker(user="./user_dict.txt", stop_word = "./stop_words.txt")
```
### 查看斷詞結果
```{r}
# 法1
segment(simps, jieba_tokenizer)
# 法2
jieba_tokenizer <= simps
# 法3
jieba_tokenizer[simps]
```
### 動態新增自訂詞彙/停用字
動態新增詞彙一定要先做才能做動態停用字(因為一旦存成一個變數，new_user_word就無法再塞進新變數的jieba_tokenizer)
```{r}
new_user_word(jieba_tokenizer, c("下一個", "驚嘆", "馬姬")) # 新增詞彙
tokens = segment(simps, jieba_tokenizer)
tokens %>% head(100)
simps = filter_segment(tokens, c("晚上好", "這周", "正", "成", "一個", "再")) # 篩除停用字
segment(simps, jieba_tokenizer) %>% head(100)
```
### 新增集數欄位
```{r}
simps_ep = data.frame(word = simps[nchar(simps)>1], stringsAsFactors = FALSE) %>%
mutate(episode = (11+cumsum(str_detect(word, regex("^第.*集$"))))) # .比對任何一個字元（換行不算） # *比對前一個字元零次或更多次
```
### 文字雲視覺化
```{r}
tokens_count = simps_ep %>%
group_by(word) %>%
summarise(count = n()) %>%
filter(count > 10) %>%
arrange(desc(count))
head(tokens_count, 10)
js_color_fun = "function (word, weight) {
return (weight > 30) ? '#f02222' : '#c09292';
}"
tokens_count %>% wordcloud2(color = htmlwidgets::JS(js_color_fun), backgroundColor = "black")
```
可以發現即使是繁體字幕，仍有一些簡體字未轉成功
# 情緒分析
## 準備字典
```{r}
p = read_file("./liwc/positive.txt")
n = read_file("./liwc/negative.txt")
positive = data.frame(word = strsplit(p, "[,]")[[1]], sentiment = "positive", stringsAsFactors = FALSE)
negative = data.frame(word = strsplit(n, "[,]")[[1]], sentiment = "negative", stringsAsFactors = FALSE)
LIWC_ch = rbind(positive, negative)
LIWC_ch %>% head(10)
```
## 以LIWC字典判斷辛普森一家台詞的情緒傾向
```{r}
simps_ep %>%
select(word) %>%
inner_join(LIWC_ch) %>%
group_by(sentiment) %>%
summarise(cnt = n())
```
## 分析每集情緒
```{r}
plot_table = simps_ep %>%
group_by(episode, word) %>%
summarise(count = n()) %>%
arrange(desc(count)) %>%
inner_join(LIWC_ch) %>%
group_by(episode, sentiment) %>%
summarise(cnt = sum(count))
plot_table %>% ggplot() +
geom_line(aes(x=episode, y=cnt, colour=sentiment)) +
ggtitle("每集情緒差異") +
theme(text=element_text(family="蘋方-繁 中黑體", size=12),
plot.title=element_text(hjust = 0.5))
```
+ 基本上皆為正面>負面，與我們平時認知的辛普森家庭稍微有些不同，我解釋原因為：
+ 辛普森雖然給人帶有嘲諷的印象，但是畢竟還是喜劇，光從詞彙意義上來判斷，很容易被歸類為正面用語
+ 字典定義影響，例如：在恐怖電影/遊戲產業專用的字典裡，「恐怖」、「嚇人」就不算負面用字，而是符合需求的正面詞彙。
+ 第13集中，正面與負面差距最大，可能是五集中最歡樂的一集
+ 第14集中，正面與負面差距最小，是較為中性的一集
## 分析第13集中的正負面詞彙
```{r}
simps_ep %>%
group_by(episode, word) %>%
summarise(count = n()) %>%
filter(episode==13) %>%
inner_join(LIWC_ch) %>%
group_by(word, sentiment) %>%
summarise(count=sum(count)) %>%
filter(count > 1) %>% # 只有1次的太多了因此濾掉
acast(word ~ sentiment, value.var = "count", fill = 0) %>%
comparison.cloud(colors = c("gray80", "gray20"),
max.words = 100, family = "蘋方-繁 中黑體")
```
Sign in with Wallet
Connect another wallet