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 "疫情防控方面要重点抓好以下工作"
网友评论