TextRank算法是一個比較耗時的算法，因為它依賴于圖計算，需要構成相似度矩陣。當數據量變大的時候，運行時間會呈“幾何級”增長。但是對于中小型的文本來說，這個方法還是非常不錯的。但是中小型的文本，還需要摘要么？盡管如此，這還是一個非常直觀的算法，如果TF-IDF在一些時候不好用的話，這是一個非常好的候補選項。
1、讀取文獻
> library(pacman)
> p_load(readtext, dplyr)
注意路徑中不能包含中文，否則會讀取不到文件。
> # 批量讀取文件夾下所有的文本文件
> dir_path <- "C:/Users/Admin/Documents/CCST/"
> files <- system.file(dir_path, package = "readtext")
> filenames <- list.files(dir_path) %>% gsub("\\.+(.*)", "", .)
>
> txt <- readtext(paste0(dir_path, "*"), encoding = "UTF-8", ignore_missing_files = F, docid_field = filenames, text_field = "texts")
> txt
## readtext object consisting of 8 documents and 0 docvars.
## # Description: df[,2] [8 x 2]
## doc_id text
## <chr> <chr>
## 1 關于研究生課程在線教學的通知（修改）.docx "\"關于2019-202\"..."
## 2 經管院非全專碩“中特”課程教學大綱、教學日歷、課件.docx "\"2019—2020學\"..."
## 3 陸婭楠-努力實現今年經濟社會發展目標任務.docx "\"陸婭楠-努力實現今年\"..."
## 4 馬院2019-2020學年第二學期研究生培養工作實施方案.docx "\"馬克思主義學院201\"..."
## 5 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx "\"在中央政治局常委會會\"..."
## 6 專題二 習近平新時代中國特色社會主義思想的豐富內涵與歷史地位.pdf "\"\n CONTENT\"..."
## # ... with 2 more rows
2、關鍵詞提取
2.1 中文分詞
> p_load(cidian, jiebaR)
> stopword <- "./dict/stopwords_wf.txt"
> # 加載用戶字典及詞性標記
> wk <- worker(user = user, type = "tag", stop_word = stopword)
> # 預處理函數，清除數字
> pre_fun = function(string) {
+ # 英文轉小寫
+ string <- tolower(string)
+ # 清除符號：!'#$%&'()*+,-./:;<=>?@[\]^_`{|}~.
+ string <- gsub("[[:punct:]]", " ", string)
+ # 清除換行符、換頁符、退格符等控制字符
+ string <- gsub("[[:cntrl:]]", " ", string)
+ # 清除<>中的內容
+ string <- gsub("<.*?>", "", string)
+ # 清除數字
+ string <- gsub("\\d+", "", string)
+ # 多個連續空格替換為單個空格
+ string <- gsub("\\s+", " ", string)
+ # 清除\n
+ string <- gsub("\\n", " ", string)
+ return(string)
+ }
> tok_fun <- function(strings) {
+ strings <- lapply(strings, pre_fun)
+ strings <- lapply(strings, segment, wk)
+ return(strings)
+ }
>
> tag_fun <- function(word) {
+ lapply(word, tibble::enframe, name = "tag", value = "word")
+ }
>
> txt_jieba <- txt %>% mutate(words = tok_fun(text)) %>% mutate(word_tag = tag_fun(words)) %>% select(doc_id, word_tag)
2.2 構造提取名詞n的函數，提取關鍵詞
> p_load(textrank, tidyr)
> extract_n <- function(df) {
+ textrank_keywords(df$word, relevant = stringr::str_detect(df$tag, "^n"), ngram_max = 2) %>% .$keywords
+ }
>
> txt_kw <- txt_jieba %>% mutate(textrank.key = lapply(word_tag, extract_n)) %>% select(-word_tag)
> txt_kw
## doc_id
## 1 關于研究生課程在線教學的通知（修改）.docx
## 2 經管院非全專碩“中特”課程教學大綱、教學日歷、課件.docx
## 3 陸婭楠-努力實現今年經濟社會發展目標任務.docx
## 4 馬院2019-2020學年第二學期研究生培養工作實施方案.docx
## 5 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx
## 6 專題二 習近平新時代中國特色社會主義思想的豐富內涵與歷史地位.pdf
## 7 專題三 社會主要矛盾轉化與中國特色社會主義進入新時代.pdf
## 8 專題一 中國特色社會主義是改革開放以來黨的全部理論和實踐的主題.pdf
## textrank.key
## 1 教學, 課程, 研究生-課程, 任課教師, 單位, 處, 課堂, 學年-學期, 學期, 課程-教學, 疫情, 教學方式, 領導, 研究生-教學, 指導, 研究生, 教學-任課教師, 任課教師-課程, 布置, 主管-領導, 統計表, 課程名稱-任課教師, 辦公室-疫情, 湖北省-教育廳, 教育廳, 實施方案-文件精神, 文件精神, 單位-任課教師, 課堂-任課教師, 信息, 指導-任課教師, 文獻, 指導-課程, 項目-入選者, 入選者-榮譽稱號, 榮譽稱號, 單位-課程, 處-學年, 教學-課程, 單位-研究生, 統計表-單位, 教學-研究生, 課程-統計表, 統計表-課程名稱, 1, 1, 2, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 2, 1, 1, 2, 2, 1, 2, 1, 2, 2, 2, 1, 2, 1, 2, 2, 1, 2, 1, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 27, 17, 8, 8, 7, 7, 6, 5, 5, 4, 3, 3, 3, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
## 2 中國-特色, 專題, 習近平, 課程, 理論, 教學, 特色, 時代-中國, 中共中央文獻研究室-習近平, 特色-理論, 特色-思想, 思想, 時間, 專題-中國, 碩士-研究生, 馬克思主義, 班, 手機號, 教學-專題, 指導, 專題-教學, 時代, 戰略, 生態, 線下, 人民出版社, 研究生-中國, 課程-教學, 國際-班, 班-課程, 中心-聯系人, 聯系人, 教學進度-本學期, 本學期, 課程-專題, 教材, 理論課-教學, 教學-指導, 教學-時間, 時間-專題, 專題-習近平, 核心-價值觀, 價值觀, 特色-生態, 國際-戰略, 教學方式, 講義, 布置-線下, 方式, 布置, 方式-時間, 馬克思主義-理論, 教材-碩士, 研究生, 理論課-教材, 教材-中國, 出版社-人民出版社, 習近平-生態, 黨史, 習近平-中國, 視頻-資料, 資料, 電視-政論, 政論, 2, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 1, 1, 2, 2, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 1, 2, 1, 2, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 1, 1, 2, 1, 1, 2, 2, 2, 1, 2, 2, 2, 2, 1, 2, 2, 1, 2, 1, 17, 12, 10, 9, 8, 8, 7, 6, 6, 5, 4, 4, 4, 4, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
## 3 疫情, 經濟, 經濟社會, 壓力, 政策, 經濟運行, 中國-經濟, 目標, 疫情-經濟, 條件-能力, 能力-經濟社會, 目標-疫情, 信心, 對沖-疫情, 餐飲-影視娛樂, 影視娛樂, 結構性-體制性, 體制性, 疫情-經濟運行, 解決問題, 中國, 優勢, 技術-基礎, 基礎, 政策-空間, 空間-市場, 市場, 貸款, 市場-信心, 產業鏈, 拓寬-產品, 產品, 1, 1, 1, 1, 1, 1, 2, 1, 2, 2, 2, 2, 1, 2, 2, 1, 2, 1, 2, 1, 1, 1, 2, 1, 2, 2, 1, 1, 2, 1, 2, 1, 16, 10, 5, 5, 5, 4, 4, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
2.3 挑選ngram更高，詞頻大于1的關鍵詞
> top3_ngram <- txt_kw %>% unnest(cols = textrank.key) %>% group_by(doc_id) %>% filter(freq > 1) %>% top_n(3, ngram) %>%
+ ungroup()
> top3_ngram
## # A tibble: 157 x 4
## doc_id keyword ngram freq
## <chr> <chr> <int> <int>
## 1 關于研究生課程在線教學的通知（修改）.docx 研究生-課程 2 8
## 2 關于研究生課程在線教學的通知（修改）.docx 學年-學期 2 5
## 3 關于研究生課程在線教學的通知（修改）.docx 課程-教學 2 4
## 4 關于研究生課程在線教學的通知（修改）.docx 研究生-教學 2 2
## 5 關于研究生課程在線教學的通知（修改）.docx 教學-任課教師 2 2
## 6 關于研究生課程在線教學的通知（修改）.docx 任課教師-課程 2 2
## 7 關于研究生課程在線教學的通知（修改）.docx 主管-領導 2 2
## 8 關于研究生課程在線教學的通知（修改）.docx 課程名稱-任課教師 2 2
## 9 經管院非全專碩“中特”課程教學大綱、教學日歷、課件.docx 中國-特色 2 17
## 10 經管院非全專碩“中特”課程教學大綱、教學日歷、課件.docx 時代-中國 2 6
## # ... with 147 more rows
2.4 篩選詞頻最高的10個詞
> top3_kw <- top3_ngram %>% count(keyword) %>% arrange(desc(n)) %>% slice(1:10)
> top3_kw
## A tibble: 10 x 2
## keyword n
## <chr> <int>
## 1 中國-特色 5
## 2 時代-中國 4
## 3 特色-思想 3
## 4 生態-文明 2
## 5 碩士-研究生 2
## 6 特色-理論 2
## 7 特色-理論體系 2
## 8 特色-社會 2
## 9 研究生-教學 2
## 10 制度-體系 2
4、文本摘要
4.1 將文章切分為語句
> get_sentence <- function(string) {
+ # 按標點符號切分
+ string %>% stringr::str_split("[:punct:]+") %>% unlist %>% tibble::enframe() %>% transmute(sentence_id = 1:n(),
+ sentence = value)
+ }
>
> get_word <- function(string) {
+ string %>% get_sentence %>% mutate(words = lapply(sentence, segment, wk)) %>% select(-sentence) %>% unnest(cols = words)
+ }
4.2 提取關鍵句函數
> rank_sentence <- function(st, wt) {
+ textrank_sentences(data = st, terminology = wt) %>% # 提取五個關鍵句
+ summary(n = 5)
+ }
4.3 選擇一個文檔生成摘要（全部生成耗時太長）
> # 隨機選擇一行
> article <- txt[sample(nrow(txt), 1), ]
> article
## readtext object consisting of 1 document and 0 docvars.
## Description: df[,2] [1 x 2]
## doc_id text
## * <chr> <chr>
## 1 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx "\"在中央政治局常委會會\"..."
> st <- get_sentence(article$text)
> wt <- get_word(article$text)
> key_sentence = rank_sentence(st,wt)
> abstract <- tibble(article$doc_id,key_sentence) %>% unnest(cols = key_sentence)
> print(abstract)
## A tibble: 5 x 2
## `article$doc_id` key_sentence
## <chr> <chr>
## 1 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx "在疫情防控工作中"
## 2 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx "關于疫情防控形勢和做好疫情防控重點工作\n 做好疫情防控工作"
## 3 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx "要在做好疫情防控的同時"
## 4 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx "全面加強疫情防控工作的局面"
## 5 習近平：新型冠狀病毒肺炎疫情工作時的講話.docx "疫情防控方面要重點抓好以下工作"
