結合jiebar與Tidy text套件，處理中文文字資料
王淯佳
2019-03-17
Abstract
結合jiebar與Tidy text套件，處理Gutenberg上的中文小說系統參數設定
Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼## Warning in Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8"): 作業
## 系統回報無法實現設定語區為 "zh_TW.UTF-8" 的要求## [1] ""setwd("D:/social media/jiebar")安裝需要的packages
packages = c("dplyr", "tidytext", "jiebaR", "gutenbergr", "stringr", "wordcloud2", "ggplot2", "tidyr", "scales")
existing = as.character(installed.packages()[,1])
for(pkg in packages[!(packages %in% existing)]) install.packages(pkg)require(dplyr)## Loading required package: dplyr##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionrequire(tidytext)## Loading required package: tidytextrequire(jiebaR)## Loading required package: jiebaR## Loading required package: jiebaRD## Warning: package 'jiebaRD' was built under R version 3.5.2require(gutenbergr)## Loading required package: gutenbergr## Warning: package 'gutenbergr' was built under R version 3.5.2library(stringr)
library(wordcloud2)## Warning: package 'wordcloud2' was built under R version 3.5.2library(ggplot2)
library(tidyr)
library(scales)Gutenberg free eBooks
Also, various chinese books can be found in the link below:
https://www.gutenberg.org/browse/languages/zh
# 下載 "木蘭奇女傳 by Anonymous" 書籍，並且將text欄位為空的行給清除，以及將重複的語句清除
red <- gutenberg_download(23938) %>% filter(text!="") %>% distinct(gutenberg_id, text)## Determining mirror for Project Gutenberg from http://www.gutenberg.org/robot/harvest## Using mirror http://aleph.gutenberg.orgView(red)# 根據上方整理出來的規則，我們可以使用正規表示式，將句子區分章節
red1 <- red %>% slice(1:16) %>% mutate(chapter = 0 )
red<- red %>% slice(17:3208)
red <- red %>%
mutate(chapter = cumsum(str_detect(red$text, regex("^第.*回( |$)"))))
red<-rbind(red1,red)str(red)## Classes 'tbl_df', 'tbl' and 'data.frame': 3208 obs. of 3 variables:
## $ gutenberg_id: int 23938 23938 23938 23938 23938 23938 23938 23938 23938 23938 ...
## $ text : chr "序" "嘗思人道之大，莫大於倫常；學問之精，莫精於性命。自有書籍以來，所載傳人不少，" "求其交盡乎倫常者鮮矣，求其交盡乎性命者益鮮矣。蓋倫常之地，或盡孝而不必兼忠，" "或盡忠而不必兼孝，或盡忠孝而安常處順，不必兼勇烈。遭際未極其變，即倫常未盡其" ...
## $ chapter : num 0 0 0 0 0 0 0 0 0 0 ...# 下載下來的書已經完成斷句了
head(red, 20)## # A tibble: 20 x 3
## gutenberg_id text chapter
## <int> <chr> <dbl>
## 1 23938 序 0
## 2 23938 嘗思人道之大，莫大於倫常；學問之精，莫精於性命。自有書籍以來，所載傳人不少，~ 0
## 3 23938 求其交盡乎倫常者鮮矣，求其交盡乎性命者益鮮矣。蓋倫常之地，或盡孝而不必兼忠，~ 0
## 4 23938 或盡忠而不必兼孝，或盡忠孝而安常處順，不必兼勇烈。遭際未極其變，即倫常未盡其~ 0
## 5 23938 難也。性命之理，有不悟性根者，有不知命蒂者，有修性命而旁歧雜出者，有修性命而~ 0
## 6 23938 後先倒置者。涵養未得其中，即性命未盡其奧也。乃木蘭一女子耳，擔荷倫常，研求性~ 0
## 7 23938 命，而獨無所不盡也哉！ 0
## 8 23938 予幼讀《木蘭詩》，觀其代父從軍，可謂孝矣；立功絕塞，可謂忠矣。後閱《唐書~ 0
## 9 23938 》，言木蘭唐女，西陵人，嫻弓馬，諳韜略，轉戰沙漠，累大功十二，何其勇也。封武~ 0
## 10 23938 昭將軍，凱旋還里。當時筮者謂致亂必由武姓，讒臣嫁禍武昭，詔徵至京。木蘭具表陳~ 0
## 11 23938 情，掣劍剜心，示使者，目視而死。死後，位證雷部大神，何其烈也。去冬閱《木蘭奇~ 0
## 12 23938 女傳》，復知其幼而領悟者性命也，長而行持者性命也。且通部議論極精微，極顯豁，~ 0
## 13 23938 又無非性命之妙諦也。盡人所當盡，亦盡人所難盡。惟其無所不盡，則亦無所不奇。而~ 0
## 14 23938 人奇，行奇，事奇，文奇，讀者莫不驚奇叫絕也。此書相傳為奎斗馬祖所演，卷首有武~ 0
## 15 23938 聖帝序。今序已失，同人集貲付梓。書成，爰敘其緣起如此。~ 0
## 16 23938 書於滬江梅花書館南窗之下 0
## 17 23938 第一回 朱若虛孝弟全天性 朱天錫聰明識童謠 1
## 18 23938 古樂府所載《木蘭辭》，乃唐初國師李藥師所作也。藥師名靖，號青蓮，又號三元~ 1
## 19 23938 道人。先生少日，負經天緯地之才，抱治國安民之志，佐太宗平隋亂，開唐基，官拜太~ 1
## 20 23938 傅，賜爵趙公。晚年修道，煉性登仙。蓋先生盛代奇人，故能識奇中奇人，保全奇中奇~ 1# 自行載入字典
jieba_tokenizer <- worker(user="mulan.txt",stop_word = "stop_words.txt")
# 設定斷詞function
red_tokenizer <- function(t) {
lapply(t, function(x) {
tokens <- segment(x, jieba_tokenizer)
return(tokens)
})
}tokens <- red %>% unnest_tokens(word, text, token=red_tokenizer)
str(tokens)## Classes 'tbl_df', 'tbl' and 'data.frame': 41867 obs. of 3 variables:
## $ gutenberg_id: int 23938 23938 23938 23938 23938 23938 23938 23938 23938 23938 ...
## $ chapter : num 0 0 0 0 0 0 0 0 0 0 ...
## $ word : chr "序" "嘗思人" "道" "大於" ...head(tokens, 20)## # A tibble: 20 x 3
## gutenberg_id chapter word
## <int> <dbl> <chr>
## 1 23938 0 序
## 2 23938 0 嘗思人
## 3 23938 0 道
## 4 23938 0 大於
## 5 23938 0 倫常
## 6 23938 0 學問
## 7 23938 0 之精
## 8 23938 0 精於
## 9 23938 0 性命
## 10 23938 0 自有
## 11 23938 0 書籍
## 12 23938 0 以來
## 13 23938 0 所載
## 14 23938 0 傳人
## 15 23938 0 求其
## 16 23938 0 交盡乎
## 17 23938 0 倫常
## 18 23938 0 鮮
## 19 23938 0 求其
## 20 23938 0 交盡乎文字雲
# 計算詞彙的出現次數，如果詞彙只有一個字則不列入計算
tokens_count <- tokens %>%
filter(nchar(.$word)>1) %>%
group_by(word) %>%
summarise(sum = n()) %>%
filter(sum>10) %>%
arrange(desc(sum))
# 印出最常見的20個詞彙
head(tokens_count, 20)## # A tibble: 20 x 2
## word sum
## <chr> <int>
## 1 木蘭 488
## 2 李靖 253
## 3 尉遲恭 189
## 4 元帥 155
## 5 天祿 109
## 6 公子 99
## 7 將軍 84
## 8 太宗 81
## 9 先生 74
## 10 次日 73
## 11 突厥 73
## 12 唐兵 72
## 13 一個 67
## 14 不知 66
## 15 寶林 65
## 16 今日 64
## 17 一日 63
## 18 軍士 61
## 19 二人 60
## 20 卻說 59tokens_count %>% wordcloud2()各章節長度，以語句數來計算
plot <-
bind_rows(
red %>%
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("句子數量") #+
#theme(text = element_text(family = "Heiti TC Light"))
plot