第九組_讀書會討論一(斷句斷詞與情緒分析)

# 分析文集為《封神演義》-作者:陳仲琳(明)
# 載入各packages
require(dplyr)

載入需要的套件：dplyr
警告： 套件 ‘dplyr’ 是用 R 版本 4.3.1 來建造的
載入套件：‘dplyr’

下列物件被遮斷自 ‘package:stats’:

    filter, lag

下列物件被遮斷自 ‘package:base’:

    intersect, setdiff, setequal, union

require(tidytext)

載入需要的套件：tidytext
警告： 套件 ‘tidytext’ 是用 R 版本 4.3.1 來建造的

require(jiebaR)

載入需要的套件：jiebaR
警告： 套件 ‘jiebaR’ 是用 R 版本 4.3.1 來建造的載入需要的套件：jiebaRD
警告： 套件 ‘jiebaRD’ 是用 R 版本 4.3.1 來建造的

library(stringr)

警告： 套件 ‘stringr’ 是用 R 版本 4.3.1 來建造的

library(wordcloud2)

警告： 套件 ‘wordcloud2’ 是用 R 版本 4.3.1 來建造的Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

library(ggplot2)

警告： 套件 ‘ggplot2’ 是用 R 版本 4.3.1 來建造的

library(tidyr)

警告： 套件 ‘tidyr’ 是用 R 版本 4.3.1 來建造的

library(scales)

警告： 套件 ‘scales’ 是用 R 版本 4.3.1 來建造的

library(jiebaR)
library(readr)

警告： 套件 ‘readr’ 是用 R 版本 4.3.1 來建造的
載入套件：‘readr’

下列物件被遮斷自 ‘package:scales’:

    col_factor

library(devtools)

警告： 套件 ‘devtools’ 是用 R 版本 4.3.1 來建造的載入需要的套件：usethis
警告： 套件 ‘usethis’ 是用 R 版本 4.3.1 來建造的

library(stringi)
library(pbapply)

警告： 套件 ‘pbapply’ 是用 R 版本 4.3.1 來建造的

library(Rcpp)

警告： 套件 ‘Rcpp’ 是用 R 版本 4.3.1 來建造的

library(RcppProgress)

警告： 套件 ‘RcppProgress’ 是用 R 版本 4.3.1 來建造的

library(cidian) # devtools::install_github("gn01830657/cidian")
library(ropencc) # devtools::install_github("Lchiffon/ropencc")
library(showtext) # C:\Users\boche\Downloads\showtext_0.9-6.zip直接使用R Tools->Install Packages...

警告： 套件 ‘showtext’ 是用 R 版本 4.3.1 來建造的載入需要的套件：sysfonts
警告： 套件 ‘sysfonts’ 是用 R 版本 4.3.1 來建造的載入需要的套件：showtextdb
警告： 套件 ‘showtextdb’ 是用 R 版本 4.3.1 來建造的

# 古騰堡網站下載《封神演義》繁體文集
library(gutenbergr)

警告： 套件 ‘gutenbergr’ 是用 R 版本 4.3.1 來建造的

Fengshen <- gutenberg_download(23910) %>% filter(text!="") %>% distinct(gutenberg_id, text)

Determining mirror for Project Gutenberg from https://www.gutenberg.org/robot/harvest
Using mirror http://aleph.gutenberg.org

View(Fengshen)
# 使用正規表示式，將句子區分章節並斷出共1~100章回
Fengshen <- Fengshen %>% mutate(chapter = cumsum(str_detect(Fengshen$text, regex("第.*回(\u00a0|$)"))))
# 文集已經完成斷句了
head(Fengshen, 20)

# 文集斷詞，設定斷詞function與停用字stop_word
jieba_tokenizer <- worker(user="Fengshen.traditional.dict", stop_word="D:/R/20200318_bookclub_1/stop_words.txt")
# stop_word="C:/Users/Sean/Documents/jiebar/stop_words.txt")
Fengshen_tokenizer <- function(t) {
  lapply(t, function(x) {
    tokens <- segment(x, jieba_tokenizer)
    return(tokens)
  })
}
tokens <- Fengshen %>% unnest_tokens(word, text, token=Fengshen_tokenizer)
str(tokens)

tibble [223,872 × 3] (S3: tbl_df/tbl/data.frame)
 $ gutenberg_id: int [1:223872] 23910 23910 23910 23910 23910 23910 23910 23910 23910 23910 ...
 $ chapter     : int [1:223872] 0 1 1 1 1 1 1 1 1 1 ...
 $ word        : chr [1:223872] "p" "第一回" "紂王" "女媧" ...

head(tokens, 20) # 全文斷詞結果

# 重點一: 計算每一章節出現字數大於1的詞彙出現的總次數
tokens_count_chapter <- tokens %>% 
  filter(nchar(.$word)>1) %>% 
  group_by(chapter,word) %>% 
  dplyr::summarise(sum = n()) %>%
  # summarise(sum = n()) %>%
  arrange(chapter) 

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

tokens_count_chapter <- top_n(tokens_count_chapter,3) # 只選出前三名的字彙

Selecting by sum

tokens_count_chapter

# 結果可以發現第一章回出現最多的是女媧、天子、紂王、諸侯，推斷可能第一回在講女媧和紂王的故事
# 到 https://zh.wikisource.org/zh-hant/%E5%B0%81%E7%A5%9E%E6%BC%94%E7%BE%A9 可以看到第一回標題是：紂王女媧宮進香

# 繪製散布圖X軸是章節，Y軸是詞彙出現的次數
ggplot(tokens_count_chapter, aes(x = chapter, y = sum,  color = abs(sum))) +  
  geom_jitter(alpha = 0.1, size = 5, width = 0.5, height = 0.5) +  
  geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5) +  
  scale_y_log10()+
  ggtitle("各章節的出現前三多次數的字") + 
  ylab(label="出現次數")+  
  xlab(label="回數") 

# 結果可以看出第一回是由女媧作為故事的開頭，最後則是以武王作為故事的結束，也可以發現各個角色大概出現的章回在哪

# 重點二:
# 封神演義內容包含了許多道教的元素
# 分析出現最多的道教詞彙
# 匯入道教詞語辭典
# fileEncoding ="UTF-8"：使用R讀取文字檔時, 有時會遇到資料匯入有錯誤訊息或中文亂碼問題
taoism <- read.table("./taoism.txt",sep = "\n" ,header = FALSE, fileEncoding ="UTF-8")
# taoism <- read.table("./20200318_bookclub_1/taoism.txt",sep = "\n" ,header = FALSE, fileEncoding ="UTF-8")
taoism_count <- tokens %>% 
  filter(nchar(.$word) > 1) %>% 
  mutate(total = nrow(tokens)) %>% 
  group_by(word) %>% 
  filter(word %in% taoism$V1) %>% 
  dplyr::summarise(count = n(), total = mean(total)) %>%
  # summarise(count = n(), total = mean(total)) %>%
  mutate(proportion = count / total) %>% 
  arrange(desc(count))
head(taoism_count, 20)

# 結果可以發現出現最多的道教詞彙為"廣成子"，廣成子為中國道教傳說的神仙
# 推斷封神演義內除了有許多歷史人物外，廣成子是代表道教的重要角色

# 計算道教詞彙在各章節出現的總數，推斷那些章節可能在講道教的故事
taoism_chapter <- tokens %>% 
  filter(nchar(.$word)>1) %>%
  filter(word %in% taoism$V1) %>%
  group_by(chapter) %>%  
  dplyr::summarise(count = n(), type = "words")%>%
  # summarise(count = n(), type = "words")%>%
  arrange(desc(count)) 
taoism_chapter

# 結果可以看出在72回是講到最多道教相關詞彙的章節

# 計算道教詞彙出現在各章節的長條圖
taoism_plot = tokens %>% 
  filter(nchar(.$word)>1) %>%
  filter(word %in% taoism$V1) %>%
  group_by(chapter) %>%  
  dplyr::summarise(count = n()) %>%
  # summarise(count = n()) %>%
  ggplot(aes(x = chapter, y=count)) +
  geom_col() + 
  ggtitle("各章節的道教詞彙出現總數") + 
  xlab("章節") + 
  ylab("道教詞彙數量")
taoism_plot

# 結果可以看出在75回前後有講到大量的道教相關詞彙

# 重點三: 文集中角色人物-哪吒的描述
# 為了找出哪吒武器，將原本沒有區分出來的斷詞加入
new_user_word(jieba_tokenizer, c("兩根火尖槍", "乾坤圈", "混天綾", "九龍神火罩","陰陽劍"))

[1] TRUE

chi_tokenizer <- function (t) {
  lapply(t, function(x){
    tokens <- segment(x, jieba_tokenizer)
    tokens <- tokens[nchar(tokens) > 1]
    return(tokens)
  })
}
# 斷詞
tokens <- Fengshen %>%
  unnest_tokens(word, text, token = chi_tokenizer)
# 將哪吒武器的等同詞保留成變數
#《封神演義》中武器是：兩根火尖槍、風火輪、乾坤圈、混天綾、金磚、九龍神火罩、陰陽劍，共八件兵器（因為封神中哪吒是三頭八臂)
# 但是原本封神演義斷詞字典中，對於哪吒武器並沒有特別區別出來
weapon_alias = c("金磚","風火輪","乾坤圈","混天綾","兩根火尖槍","九龍神火罩","陰陽劍")
# 計算哪吒武器在整本書中出現的頻率及比例，可以發現哪吒使用風火輪次數最多
weapon_count = tokens %>% 
  filter(nchar(.$word)>1) %>%                     # 保留非空白資料
  mutate(total = nrow(tokens)) %>%                # 加入一個total (資料總列數)   
  group_by(word) %>% 
  filter(word %in% weapon_alias) %>%              # 保留詞
  dplyr::summarise(count = n(), total = mean(total)) %>%
  # summarise(count = n(), total = mean(total)) %>%
  mutate(proportion = count / total) %>%          # 加入比例欄位
  arrange(desc(count))                            # 根據count欄位，由大至小排列
head(weapon_count, 20)

# 計算哪吒武器在各章節出現的總數，推斷哪吒出場抄傢伙最多的章節
weapon_chapter <- tokens %>% 
  filter(nchar(.$word)>1) %>%
  filter(word %in% weapon_alias) %>%
  group_by(chapter) %>%  
  dplyr::summarise(count = n(), type = "words")%>%
  # summarise(count = n(), type = "words")%>%
  arrange(desc(count)) 
weapon_chapter

# 可以看出第13章及第34章總量最多
# 第十三章講哪吒年輕時連續闖禍，殺害龍王親人、石磯娘娘的弟子，把自己的父母師父都拖下水，一陣大亂鬥之後，
# 眼見四海龍王要來取他父母的性命，哪吒只好自殺，留下一縷幽魂，結束這場鬧劇。
# 第三十四章講成年的哪吒奉太乙真人之命，大亂鬥打敗韓榮、余化，救出黃飛虎、黃滾父子，並打通汜水關讓武成王黃飛虎一家，
# 可以奔走到西岐投靠周武王，增加周王朝的軍事力量。
# 從這兩章可以看到哪吒性格從讓父母頭痛、只會闖禍鬧事的流氓，蛻變為成熟並懂得運用自身的力量成就建國大業的神仙。

# 可直接使用字型檔並且將圖形輸出至各種圖檔
# Loading Google fonts (https://fonts.google.com/)
# font_families_google() 函數查看google提供的字型列表

font_add_google("Noto Sans TC", "NotoSansTC") # 安裝字體為思源黑體
showtext_auto(enable = TRUE, record = TRUE) # 啟動字體

# 計算哪吒武器出現最多的章節統計圖
weapon_plot = tokens %>% 
  filter(nchar(.$word)>1) %>%
  filter(word %in% weapon_alias) %>%
  group_by(chapter) %>%  
  dplyr::summarise(count = n()) %>%
  # summarise(count = n()) %>%
  ggplot(aes(x = chapter, y=count)) +
  geom_col() + 
  ggtitle("各章節的哪吒武器出現總數") + 
  xlab("章節") + 
  ylab("哪吒武器數量") +
  theme(text = element_text(family = "NotoSansTC")) # 加入中文字型設定，避免中文字顯示錯誤
weapon_plot

# 重點四: 情緒分析
# 準備LIWC字典(utf8)
p<-read_file("D:/R/20200318_bookclub_1/dic/liwc/positive.txt")
n<-read_file("D:/R/20200318_bookclub_1//dic/liwc/negative.txt")
# p<-read_file("C:/Users/Sean/Documents/20200318_bookclub_1/dic/liwc/positive.txt")
# n<-read_file("C:/Users/Sean/Documents/20200318_bookclub_1/dic/liwc/negative.txt")
positive <- strsplit(p, "[,]")[[1]]
negative <- strsplit(n, "[,]")[[1]]
positive <- data.frame(word = positive, sentiments = "positive")
negative <- data.frame(word = negative, sentiemtns = "negative")
colnames(negative) = c("word","sentiment")
colnames(positive) = c("word","sentiment")
LIWC_ch <- rbind(positive, negative)
head(LIWC_ch, 20)

# LIWC字典中有多少正面單詞和負面單詞
LIWC_ch %>% filter(sentiment %in% c("positive", "negative")) %>% count(sentiment)

# 以LIWC字典判斷文集中的word屬於正面字還是負面字
# 先將tokens斷詞後的文集過濾詞彙，只有一個字則不列入計算(也過濾掉空格)
all_fengshen_words <- tokens %>% filter(nchar(.$word)>1)
# 計算所有各詞彙的出現總數
all_word_count <- all_fengshen_words %>% group_by(word) %>% dplyr::summarise(sum = n()) %>% arrange(desc(sum))
# 計算所有字在文集中出現的總數
word_count <- all_word_count %>%
  select(word,sum) %>% 
  group_by(word) %>% 
  summarise(sum = sum(sum)) %>%
  filter(sum>3)
print(word_count)

# 與LIWC情緒字典join，文集中的字出現在LIWC字典中是屬於positive還是negative
liwch_ch_word_counts<-word_count %>% inner_join(LIWC_ch)

Joining with `by = join_by(word)`

print(liwch_ch_word_counts)

liwch_ch_word_counts %>% filter(sentiment %in% c("positive", "negative")) %>% count(sentiment)

# 繪圖出以LIWC字典統計的文集情緒字數，觀察兩種情緒值的差異
liwch_ch_word_counts %>%
  group_by(sentiment) %>%
  top_n(10,wt = sum) %>%
  ungroup() %>% 
  mutate(word = reorder(word, sum)) %>%
  ggplot(aes(word, sum, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  theme(text=element_text(size=14))+
  coord_flip()

# 情緒分析(續)
# 準備NTUSD字典(utf8)
pn<-read_file("./dic/ntusd/positive.txt")
nn<-read_file("./dic/ntusd/negative.txt")
# pn<-read_file("C:/Users/Sean/Documents/20200318_bookclub_1/dic/ntusd/positive.txt")
# nn<-read_file("C:/Users/Sean/Documents/20200318_bookclub_1/dic/ntusd/negative.txt")
ps<-strsplit(pn, "[\n]")[[1]]
positive_ntusd<-strsplit(ps, "[\r]")
ns<-strsplit(nn, "[\n]")[[1]]
negative_ntusd<-strsplit(ns, "[\r]")
# 用unlist拆分list後重構矩陣然後轉換為dataframe
positive_ntusd<-data.frame(matrix(unlist(positive_ntusd), nrow=2812, ncol=1, byrow=F),sentiments="positive", stringsAsFactors=FALSE)
colnames(positive_ntusd)<-c("word", "sentiment")
negative_ntusd<-data.frame(matrix(unlist(negative_ntusd), nrow=8276, ncol=1, byrow=F), sentiments="negative", stringsAsFactors = FALSE)
colnames(negative_ntusd)<-c("word","sentiment")
NTUSD_ch<-rbind(positive_ntusd, negative_ntusd)
head(NTUSD_ch, 20)

# NTUSD字典中有多少正面單詞和負面單詞
NTUSD_ch %>% filter(sentiment %in% c("positive", "negative")) %>% count(sentiment)

# 以NTUSD字典判斷文集中的word屬於正面字還是負面字
# 先將tokens斷詞後的文本過濾詞彙，只有一個字則不列入計算(也過濾掉空格)
all_fengshen_words_ntusd <- tokens %>% filter(nchar(.$word)>1)
# 計算所有各詞彙的出現總數
all_word_count_ntusd <- all_fengshen_words_ntusd %>% group_by(word) %>% summarise(sum = n()) %>% arrange(desc(sum))
# 計算所有字在文集中出現的總數
word_count_ntusd <- all_word_count_ntusd %>%
  select(word,sum) %>% 
  group_by(word) %>% 
  summarise(sum = sum(sum)) %>%
  filter(sum>3)
print(word_count_ntusd)

# 與NTUSD情緒字典join，文集中的字出現在NTUSD字典中是屬於positive還是negative
ntusd_ch_word_counts<-word_count_ntusd %>% inner_join(NTUSD_ch)

Joining with `by = join_by(word)`

print(ntusd_ch_word_counts)

ntusd_ch_word_counts %>% filter(sentiment %in% c("positive", "negative")) %>% count(sentiment)

# 繪圖出以NTUSD字典統計的文集情緒字數，觀察兩種情緒值的差異
ntusd_ch_word_counts %>%
  group_by(sentiment) %>%
  top_n(10,wt = sum) %>%
  ungroup() %>% 
  mutate(word = reorder(word, sum)) %>%
  ggplot(aes(word, sum, fill = sentiment)) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~sentiment, scales = "free_y") +
  labs(y = "Contribution to sentiment",
       x = NULL) +
  theme(text=element_text(size=14))+
  coord_flip()

# 重點五: 文字雲
# 計算詞彙的出現次數，如果詞彙只有一個字則不列入計算
tokens_count <- tokens %>% 
  filter(nchar(.$word)>1) %>%
  group_by(word) %>% 
  summarise(sum = n()) %>% 
  filter(sum>10) %>%
  arrange(desc(sum))
head(tokens_count, 20)

# 文字雲分布詞彙 (全文集)
tokens_count %>% wordcloud2()

# 繪圖出《封神演義》各章節長度，以語句數來計算
fengshen_plot <- bind_rows(Fengshen %>% group_by(chapter) %>% summarise(count = n(), type="sentences"), tokens %>% group_by(chapter) %>% summarise(count = n(), type="words")) %>% group_by(type) %>% ggplot(aes(x = chapter, y=count, fill="type", color=factor(type))) + geom_line() + 
ggtitle("各章節的句子總數") + xlab("章節") + ylab("句子數量") 
print(fengshen_plot)

# 計算前五十回和後五十回的詞彙在全文中出現比率的差異
frequency1 <- tokens %>% mutate(part = ifelse(chapter<=50, "First50", "Last50")) %>%
  filter(nchar(.$word)>1) %>%
  mutate(word = str_extract(word, "[^0-9a-z']+")) %>%
  mutate(word = str_extract(word, "[^一二三四五六七八九十]+"))
attach(frequency1)
frequency2 <- frequency1 %>% 
  count(part, word) %>%
  group_by(part) %>%
  mutate(proportion = n / sum(n)) %>% 
  select(-n) %>% 
  spread(part, proportion) %>% 
  gather(part, proportion, `Last50`)
# 匯出圖表
ggplot(frequency2, aes(x = proportion, y = `First50`, color = abs(`First50` - proportion))) +
  geom_abline(color = "gray50", lty = 2) +
  geom_jitter(alpha = 0.1, size = 2.5, width = 0.3, height = 0.3) +
  geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5) +
  scale_x_log10(labels = percent_format()) +
  scale_y_log10(labels = percent_format()) +
  scale_color_gradient(limits = c(0, 0.001), low = "darkslategray4", high = "gray75") +
  theme(legend.position="none") +
  labs(y = "Firs50", x = "Last50")

# 重點六: 比較《封神演義》前五十回和後五十回最常出現的前100個詞彙的差異
often_words <- tokens %>% mutate(part = ifelse(chapter<=50, "First50", "Last50")) %>% filter(nchar(.$word)>1)
first_50<-as_tibble(head(often_words, 80223))
last_50<-as_tibble(tail(often_words, 86764))
# 計算詞彙的出現次數，如果詞彙只有一個字則不列入計算
first50_count <- first_50 %>% filter(nchar(.$word)>1) %>% group_by(word) %>% summarise(sum = n()) %>% filter(sum>10) %>% arrange(desc(sum))
last50_count <- last_50 %>% filter(nchar(.$word)>1) %>% group_by(word) %>% summarise(sum = n()) %>% filter(sum>10) %>% arrange(desc(sum))
print(first50_count);print(last50_count)

# 視覺化長條圖
first50_bar <- first50_count %>% filter(sum>100) %>% mutate(word=reorder(word, sum)) %>% ggplot(aes(word, sum)) + geom_col() + xlab(NULL) + coord_flip()
last50_bar <- last50_count %>% filter(sum>100) %>% mutate(word=reorder(word, sum)) %>% ggplot(aes(word, sum)) + geom_col() + xlab(NULL) + coord_flip()
# 將兩張ggplot圖合併為一張圖
library(Rmisc)

警告： 套件 ‘Rmisc’ 是用 R 版本 4.3.1 來建造的載入需要的套件：lattice
載入需要的套件：plyr
警告： 套件 ‘plyr’ 是用 R 版本 4.3.1 來建造的-------------------------------------------------------------------------------------------------------
You have loaded plyr after dplyr - this is likely to cause problems.
If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
library(plyr); library(dplyr)
-------------------------------------------------------------------------------------------------------

載入套件：‘plyr’

下列物件被遮斷自 ‘package:dplyr’:

    arrange, count, desc, failwith, id, mutate, rename, summarise, summarize

multiplot(first50_bar, last50_bar, cols=2)