第四週讀書會作業
第三組
2021/03/21
主題:
繁體版聖經合本文字分析
組員:
林子紘 B074020021 彭璿祐 B064020029 徐明暇 D084020002 劉晉瑋 M094020006 洪玟君 M094020030 林永盛 M094020042 黃天原 M094020067
系統參數設定
Sys.setlocale(category = "LC_ALL", locale = "zh_TW.UTF-8") # 避免中文亂碼## [1] ""安裝需要的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)載入packages
require(dplyr)
require(tidytext)
require(jiebaR)
require(gutenbergr)
require(stringr)
require(wordcloud2)
require(ggplot2)
require(tidyr)
require(scales)文本分析：繁體版聖經合本
require(dplyr)
require(ggplot2)
require(data.table)
require(scales)
require(wordcloud2)
require(tidytext)bible <- fread("./bibble.txt", encoding = "UTF-8",fill=TRUE)
str(bible)## Classes 'data.table' and 'data.frame': 31238 obs. of 5 variables:
## $ book : chr "=001" "Ge" "Ge" "Ge" ...
## $ chapter : chr "Genesis" "1:1" "1:2" "1:3" ...
## $ ch_book : chr "-" "創世紀" "創世紀" "創世紀" ...
## $ ch_chapter: chr "創世紀" "1:1" "1:2" "1:3" ...
## $ text : chr "" "起初 神創造天地。" "地是空虛混沌．淵面黑暗． 神的靈運行在水面上。" " 神說、要有光、就有了光。" ...
## - attr(*, ".internal.selfref")=<externalptr>#下載繁體聖經合本 針對舊約,新約聖經每一卷進行編碼
bible_1 <- bible %>%
mutate(bookcode = cumsum(str_detect(bible$book,regex("^="))))
bible_2 <- bible %>%
mutate(bookcode = cumsum(str_detect(bible$book,regex("^=[0-1][0-9]{2}")))) %>% select (-book,-chapter)
#格式是=第1碼是0或1,0:舊約, 1:新約, 第2-3碼為流水號
str(bible_2)## Classes 'data.table' and 'data.frame': 31238 obs. of 4 variables:
## $ ch_book : chr "-" "創世紀" "創世紀" "創世紀" ...
## $ ch_chapter: chr "創世紀" "1:1" "1:2" "1:3" ...
## $ text : chr "" "起初 神創造天地。" "地是空虛混沌．淵面黑暗． 神的靈運行在水面上。" " 神說、要有光、就有了光。" ...
## $ bookcode : int 1 1 1 1 1 1 1 1 1 1 ...
## - attr(*, ".internal.selfref")=<externalptr>根據上方整理出來的規則，我們可以使用正規表示式，將句子區分新舊約
head(bible_2,10)## ch_book ch_chapter
## 1: - 創世紀
## 2: 創世紀 1:1
## 3: 創世紀 1:2
## 4: 創世紀 1:3
## 5: 創世紀 1:4
## 6: 創世紀 1:5
## 7: 創世紀 1:6
## 8: 創世紀 1:7
## 9: 創世紀 1:8
## 10: 創世紀 1:9
## text bookcode
## 1: 1
## 2: 起初 神創造天地。 1
## 3: 地是空虛混沌．淵面黑暗． 神的靈運行在水面上。 1
## 4: 神說、要有光、就有了光。 1
## 5: 神看光是好的、就把光暗分開了。 1
## 6: 神稱光為晝、稱暗為夜．有晚上、有早晨、這是頭一日。 1
## 7: 神說、諸水之間要有空氣、將水分為上下。 1
## 8: 神就造出空氣、將空氣以下的水、空氣以上的水分開了．事就這樣成了。 1
## 9: 神稱空氣為天．有晚上、有早晨、是第二日。 1
## 10: 神說、天下的水要聚在一處、使旱地露出來．事就這樣成了。 1下載下來的書已經完成斷句
自定義聖經專有名詞字典(目前為先知的名字)
參考維基百科:http://www.google.com/
# 加入自定義的字典
bible_jieba_tokenizer <- worker(user="bible_lexicon.tradictional_2.txt", stop_word = "bible_stop_words.txt")設定聖經斷詞
#設定斷詞function
bible_tokenizer <- function(t) {
lapply(t, function(x) {
tokens <- segment(x, bible_jieba_tokenizer)
return(tokens)
})
}bible_tokens <- bible_2 %>% unnest_tokens(word, text, token=bible_tokenizer)
str(bible_tokens)## Classes 'data.table' and 'data.frame': 552052 obs. of 4 variables:
## $ ch_book : chr "創世紀" "創世紀" "創世紀" "創世紀" ...
## $ ch_chapter: chr "1:1" "1:1" "1:1" "1:1" ...
## $ bookcode : int 1 1 1 1 1 1 1 1 1 1 ...
## $ word : chr "起初" " " "神" "創造" ...
## - attr(*, ".internal.selfref")=<externalptr>head(bible_tokens, 10)## ch_book ch_chapter bookcode word
## 1: 創世紀 1:1 1 起初
## 2: 創世紀 1:1 1
## 3: 創世紀 1:1 1 神
## 4: 創世紀 1:1 1 創造
## 5: 創世紀 1:1 1 天地
## 6: 創世紀 1:2 1 地是
## 7: 創世紀 1:2 1 空虛
## 8: 創世紀 1:2 1 混沌
## 9: 創世紀 1:2 1 淵
## 10: 創世紀 1:2 1 面視覺化分析
##文字雲
計算詞彙的出現次數，如果只有一個字 -> 不列入計算
bible_tokens_count <- bible_tokens %>%
filter(nchar(.$word)>1) %>%
group_by(word) %>%
summarise(sum = n()) %>%
filter(sum>10) %>%
arrange(desc(sum))印出最常見的50個詞彙
head(bible_tokens_count, 100)## # A tibble: 100 x 2
## word sum
## <chr> <int>
## 1 耶和華 6980
## 2 以色列 2704
## 3 兒子 2398
## 4 耶穌 1496
## 5 大衛 1164
## 6 知道 1078
## 7 猶大 1017
## 8 摩西 870
## 9 百姓 828
## 10 耶路撒冷 819
## # ... with 90 more rows以出現次數前100的字製作成文字雲
head(bible_tokens_count, 100) %>% wordcloud2()各卷的句子及詞彙長度
以句子數量來做計算
length_chap<-
bind_rows(
bible_2 %>%
group_by(bookcode) %>%
summarise(count = n(), type="sentences"),
bible_tokens %>%
group_by(bookcode) %>%
summarise(count = n(), type="words")) %>%
group_by(type)%>%
ggplot(aes(x = bookcode, y=count, fill="type", color=factor(type))) +
geom_line() +
ggtitle("各卷句子總數") +
xlab("卷") +
ylab("句子數量") +
theme(text = element_text(family = "Heiti TC Light"))
length_chap
計算舊約和新約中，詞彙出現比率的差異
bible_freq <- bible_tokens %>% mutate(part = ifelse(bookcode<40, "Old Testament", "New Testament")) %>%
filter(nchar(.$word)>1) %>%
mutate(word = str_extract(word, "[^0-9a-z']+")) %>%
mutate(word = str_extract(word, "^[^一二三四五六七八九十]+")) %>%
count(part, word) %>%
group_by(part) %>%
mutate(proportion = n / sum(n)) %>%
select(-n) %>%
spread(part, proportion) %>%
gather(part, proportion, `New Testament`)
ggplot(bible_freq, aes(x = proportion, y = `Old Testament`, color = abs(`Old Testament` - proportion))) +
geom_abline(color = "gray40", 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, family="Heiti TC Light") +
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 = "Old Testament", x = "New Testament")