R语言自动提取新闻摘要的简单实现

之前用R做过一些文本处理的工作，主要就是对新闻做做分类、提取关键词之类的，通过jiebaR包和自定义词典可以轻松地完成大部分工作，分类也就是整理一下各类别的特征然后跑一个分类模型就能得到比较满意的结果，唯独自动生成摘要这块一直没有找到很好的解决方法，没有找到R中现成的工具包。由于写代码能力也比较捉鸡，所以参考了java和python中的代码之后还是无法写出像样的程序出来。于是最终的解决方案就是把文章的前几句话截取出来当成摘要，效果可想而知...

随着对R和python越来越熟悉，并且最近读到了一篇详细讲解python实现textRank算法的文章（《你还在被标题党蒙骗吗？是时候试试文本摘要技术了（附源码）》），于是动手试了一下将其改成R代码，经过一番“艰苦”的搬运之后终于能在R中实现自动提取摘要的功能了。

textRank算法的原理就不过多介绍了（想了解的可以参考这里），直接说一下代码：

1. 加载包

if(!"jiebaR" %in% (.packages())) library(jiebaR)
if(!"dplyr" %in% (.packages())) library(dplyr)
keys <- worker("keywords",topn = 10)

程序中主要用到了jiebaR包和dplyr包，需加载到当前环境中，并初始化一个用于提取关键词的分词引擎keys。这里默认了10个关键词，因为处理的新闻文本文字量不大，所以10个关键词能够满足需求。对于长文本可以适当添加关键词数量。

2. 单句切割

定义一个切割句子的函数，利用punctuationVec里的标点符号来作为分割标识符。这里相比于python代码做了一些简化，因为新闻中一般不会出现~和！！！之类的标点符号，因此没有对这些标点做考虑。除此之外英文句号.也没有考虑，因为会和小数点混淆，暂时没有想到很好的区分方法，于是就暂时去掉了。。。所以只适合做中文摘要的提取。

get_sentences <- function(text,punctuationVec = c("!","?","。","！","？",">")){sentences <- c()start_word_position <- 1word_position <- 1splitwords <- strsplit(text,split="") %>% unlistfor(i in 1:length(splitwords)){word_position <- word_position + 1if(splitwords[i] %in% punctuationVec & !(splitwords[i+1] %in% c("”","。"))){sentences <- append(sentences,substr(text,start_word_position,word_position-1))start_word_position <- word_position}}return(sentences)
}

3. 关键句筛选

单句切分之后对句子的集合做一下筛选，对于长度过短的句子，或者不包含整篇文本关键词的句子予以剔除，保留重要性比较高的句子。这里还去掉了一些标题性的句子，标题一般不会包含断句的标点符号，以此作为依据识别并剔除。

filter_sentences <- function(text){keyw <- keywords(.,keys)sentences <- get_sentences(text)if(sum(nchar(sentences) < 15) > 0) sentences <- sentences[-which(nchar(sentences) < 15)]keyw_num <- vector(length = length(sentences))for(i in 1:length(keyw)){keyw_num <- keyw_num + grepl(keyw[i],sentences)}if(sum(keyw_num < 2) > 0) sentences <- sentences[-which(keyw_num < 2)]if(sum(!grepl("[。！？“”]",sentences)) > 0) sentences <- sentences[-which(!grepl("[。！？“”]",sentences))]return(sentences)
}

4. 获取每个句子的关键词，生成一个list

对筛选后的句子做切词，每个句子生成一串词语集合，用于做相似度计算

get_words_list <- function(sentences){w_list <- list()for(i in 1:length(sentences)){w_list[[i]] <- segment(sentences[i],seg)}return(w_list)
}

5. 计算句子间的相似度

相似度计算的原则是两个句子相同单词的数量除以每个句子单词数量取log的乘积，以此生成一个相似度的矩阵，并做标准化处理

get_similarity <- function(w_list){num <- length(w_list)sim_matrix <- matrix(0,num,num)for(i in 1:num){for(j in i:num){sim_matrix[i,j] <- length(intersect(w_list[[i]],w_list[[j]]))/(log(length(w_list[[i]]))*log(length(w_list[[i]])))sim_matrix[j,i] <- sim_matrix[i,j]}}for(i in 1:num){row_sum <- sum(sim_matrix[i,])for(j in 1:num){sim_matrix[i,j] <- sim_matrix[i,j]/row_sum}}return(sim_matrix)
}

6. 进行textRank迭代计算，得到最终的权重向量

textRank <- function(start_weight,iters,d,sim_matrix){count1 <- 0num <- nrow(sim_matrix)while(count1 < iters){start_weight <- matrix(1,1,num)*(1-d) + ((start_weight %>% as.matrix %>% t) %*% sim_matrix) * dstart_weight <- as.vector(start_weight)count1 <- count1 + 1}end_weight <- start_weightreturn(end_weight)
}

7. 定义生成摘要的函数，在内部调用以上方法

新闻文本一般不会太长，测试发现基本迭代十次左右权重就收敛了，所以这里设置为20次迭代，并限制提取的句子数量为3句。d为阻尼因子，一般取0.85。

get_zh_summary <- function(text,iters = 20,d = 0.85,sentence_num = 3){if(!grepl("。",text)){summary1 <- "" }else{sentences <- text %>% filter_sentencesif(length(sentences)==0){summary1 <- ""}else{sim_matrix <- sentences %>% get_words_list %>% get_similaritystart_rank <- c(rep(1,nrow(sim_matrix)))tr <- textRank(start_rank,iters,d,sim_matrix)summary_num <- c()for(i in 1:length(tr)){if(sum(tr > tr[i]) < sentence_num){summary_num <- append(summary_num,i)} }summary1 <- ""for(i in 1:length(summary_num)){summary1 <- paste0(summary1,sentences[(summary_num[i])])}}}return(summary1)
}

纯R语言版本，没做太多的优化，效率比较堪忧，而且做了一些简化处理可能会影响最终的结果，这里仅仅作为一个练手加深一下对textRank算法的理解。希望jiebaR包能够早日整合好这个功能。

R语言自动提取新闻摘要的简单实现相关推荐

c++语言get:_用C++给R语言加速：Rcpp简单用法
作者:黄天元,复旦大学博士在读,热爱数据科学与开源工具(R),致力于利用数据科学迅速积累行业经验优势和科学知识发现,涉猎内容包括但不限于信息计量.机器学习.数据可视化.应用统计建模.知识图谱等,著有& ...
R语言学习笔记【简单语法总结-上】
简单语法总结[上]: R语言特征总览: 对大小写敏感通常,数字,字母,. 和 _都是允许的(在一些国家还包括重音字母).不过,一个命名必须以 . 或者字母开头,并且如果以 . 开头,第二个字符不允许 ...
R语言lm函数构建简单线性回归（建立线性回归模型）、拟合回归直线、通过方差分析按变异的来源把结果变量的自由度、平方和、平均平方和进行分解、使用回归平方和与总的平方和计算调整R方指标（调整后的决定系数）
R语言使用lm函数构建简单线性回归模型(建立线性回归模型).拟合回归直线.通过方差分析按变异的来源把结果变量的自由度.平方和.
R语言NBA球员数据挖掘简单实现
数据集下载地址: 链接:https://pan.baidu.com/s/1KN_A9JLMvHcl0hHTBSQ4HA 提取码:spsa 第一步骤:(导入csv数据) 使用read.table()导 ...
R语言（二）——简单线性模型中的指数变换
目录一.数据 1.数据信息 2.数据处理二.简单线性回归三.指数变换四.生存分析数据的Cox回归模型一.数据 1.数据信息口咽癌数据(pharynx.csv)是针对口咽若干位置癌细胞的临床 ...
R语言do.call函数简单说明
Tips:可能有人对do.call函数不太了解, 这里简单举个例子说明此处的do.call使用效果. dat <- list(matrix(1:25, ncol = 5), matrix(4:2 ...
R语言 DESeq2 基因差异分析简单备注版火山图
RT #加载数据 linba代表淋巴 lnc <- read.csv("K0.csv") #保证ID的唯一性,删除重复 table(duplicated(lnc$id)) i ...
mcem r语言代码_一个简单文本分类任务-EM算法-R语言
一.问题介绍概率分布模型中,有时只含有可观测变量,如单硬币投掷模型,对于每个测试样例,硬币最终是正面还是反面是可以观测的.而有时还含有不可观测变量,如三硬币投掷模型.问题这样描述,首先投掷硬币A,如 ...
独家 | 手把手教你学习R语言（附资源链接）
作者:NSS 翻译:杨金鸿术语校对:韩海畴全文校对:林亦霖本文约3000字,建议阅读7分钟. 本文为带大家了解R语言以及分段式的步骤教程! 人们学习R语言时普遍存在缺乏系统学习方法的问题.学习者 ...

R语言自动提取新闻摘要的简单实现

R语言自动提取新闻摘要的简单实现相关推荐

最新文章

热门文章