r语言文本分析主题模型文本分类文本聚类

 

 

0、数据介绍

数据来源，火车头（感谢同事程志斌）采集。由于不会写代码，只能第三方了.从凤凰新闻采集：财经、军事、科技、禅道四类文章总共207篇。

 

如下：

一  、文本数据处理

      文本分析最关键就是分词了，只有分好了词才能去寻找关键特征，最后根据自己的需要做一些分析工作，我比较喜欢结巴分词（比较稳定）。以前用过李建的rwordseg，后来由于rjava不稳定，加载不了自定义字典，另一个原因是结巴安装比较简单，尤其对我这样非it专业出身的人来说省了不少事情。

 

setwd("e://r语言学习//r代码")
data <- read.csv("新闻.csv",header=T,stringsAsFactors=T)

######################数字处理##########################

removeNumbers = function(x) { ret = gsub("[0-9０１２３４５６７８９]","",x)}

sample.words <- lapply(data$内容, removeNumbers)
doc=c(NULL)
for(i in 1:dim(data)[1]){
  doc=c(doc,sample.words[i])
}
#################################################################
# 字母处理
doc=gsub(pattern="[a-zA-Z]+","",doc)
#################################################################
#分词
library(jiebaR)
tagger<-worker()
doc_CN=list()
for(j in 1:length(doc)){
  doc_CN[[j]]=c( tagger<=doc[j])
}

mystopwords<- unlist (read.table("E:\\textmining\\stopword\\中文停用词.txt",stringsAsFactors=F))
###################去停用词##############################

sample.words <- lapply(doc, wordsegment)
for(i in 1:length(sample.words))
{
 sample.words[[i]]=sample.words[[i]][!sample.words[[i]]%in%mystopwords]
 
  sample.words[[i]]=subset(sample.words[[i]],nchar(as.character(sample.words[[i]]))>1 )
  sample.words[[i]]=paste(sample.words[[i]],sep =" ",collapse =" ")
}

#######################################################

二、主题模型训练

主题模型，太他妈的理论了。足以证明学数学的也没什么了不起，还是看不懂。也许是自己学艺不精。就简单介绍一下吧。主题模型属于机器学习里面的无监督学习类的模型，我想大家肯定想到了kmeans聚类，kmeans是从文档层面的聚类，而主题模型是从文档内部的主题去聚类。kmeans是你给定类的个数，机器自动聚成多少类，而主题模型就是你给定主题个数，机器自动聚成多少主题。好了，其他的不说了，再说你就晕了，会用就行。

############################################

library(lda)
corpus <- lexicalize(sample.words, lower=TRUE)

 

num.topics <- 4#4个主题
## Initialize the params
params <- sample(c(-1, 1), num.topics, replace=TRUE)
poliblog.ratings<- sample(c(-100, 100), 207, replace=TRUE)

result <- slda.em(documents=corpus$documents,
                 K=num.topics,
                 vocab=corpus$vocab,
                 num.e.iterations=30,
                 num.m.iterations=12,
                 alpha=1.0, eta=0.1,
                 poliblog.ratings / 100,
                 params,
                 variance=0.25,
                 lambda=1.0,
                 logistic=FALSE,
                 method="sLDA")

## Make a pretty picture.

Topics <- apply(top.topic.words(result$topics, 8,by.score=TRUE),
               2, paste, collapse=" ")
aa=length(Topics)
t=c()
for(i in 1:aa)
{t[i]=paste(i,Topics[i],sep="")}

a=apply(result$document_sums,
       1,sum)
names(a)<-t
p=data.frame(a=t,b=a)
p=p[order(p[,2],decreasing=T),]
a1=c()
c=c("a","b","c","d","e","f","g","h","i","j","k","l","m","n","o","p","q","r","s","t","u","v","w","x","y","z"
   ,"za","zb","zc","zd")
for(i in 1:aa)
{
  a1[i]= paste(c[i],p$a[i],sep="")
 
}
p1=data.frame(a=a1,主题得分=p$b)
library(ggplot2)
ggplot(data=p1, aes(x=a, y=主题得分, fill=主题得分)) +
  geom_bar(colour="black", stat="identity")+
  labs(x = "主题", y = "得分") + ggtitle("文档主题排名顺序")+coord_flip()

Topics <- top.topic.words(result$topics, 20,by.score=TRUE)

 

a=c()
b=c()
for(i in 1:5)
{
  a=c(a,Topics[,i])
  b=c(b,rep(paste("主题",i,sep=""),20))
}

a = table(a, b)
a = as.matrix(a)
library(wordcloud)

comparison.cloud(a, scale = c(1, 1.5), rot.per = 0.5, colors =brewer.pal(ncol(a),
                                                                         "Dark2"))

主题1：金融   主题2：禅道  主题3 ：军事  主题4 科技

 

 

三、文本分类

提到文本聚类就要说到r语言的tm包，该包的作用就是生成文本文档矩阵，这个比较方便。但是如果你的文本特征不是词频，tf-IDF，那么他们包就没什么用了。

library("tm")
reuters =VCorpus(VectorSource(doc_CN))
reuters <- tm_map(reuters, stripWhitespace)

data_stw<- unlist (read.table("E:\\textmining\\stopword\\中文停用词.txt",stringsAsFactors=F))
#head(data_stw,n=10)

reuters=tm_map(reuters,removeWords,data_stw) # 删除停用词
############################

####生成tfidf特征##################

control=list(removePunctuation=T,minDocFreq=5,wordLengths = c(1,Inf),weighting = weightTfIdf)
doc.tdm=TermDocumentMatrix(reuters,control)
length(doc.tdm$dimnames$Terms)

tdm_removed=removeSparseTerms(doc.tdm, 0.97)
length(tdm_removed$dimnames$Terms)
mat = as.matrix(tdm_removed)####转换成文档矩阵

classifier = naiveBayes(mat[1:x,], as.factor(data$标题[1:x]))##贝叶斯分类器，训练
predicted = predict(classifier, mat[z:y,]);#预测
A=table(data$标题[z:y], predicted)#预测交叉矩阵

predicted财经 禅道 军事  科技

   财经   10   28    34    1  禅道     0   41     4    0  军事     0   10    25    0  科技     4   21    18   11

b1=length(which(predicted==data$标题[z:y]))/length(predicted)#计算召回率

> b1[1] 0.4202899##有点低哈！！！！

###寻找其他的机器学习分类算法

library(RTextTools)

container = create_container(mat[1:y,], as.factor(data$标题[1:y]),
                            trainSize=1:x, testSize=1:y,virgin=TRUE)
models = train_models(container, algorithms=c("BAGGING",  "MAXENT" ,  "NNET",   "RF"   ,   "SVM" ,    "TREE"))
results = classify_models(container, models)
#How about the accuracy?

 

# recall accuracy
森林=recall_accuracy(as.numeric(as.factor(data$标题[z:y])),results[,"FORESTS_LABEL"])
最大熵=recall_accuracy(as.numeric(as.factor(data$标题[z:y])),results[,"MAXENTROPY_LABEL"])
决策树=recall_accuracy(as.numeric(as.factor(data$标题[z:y])),results[,"TREE_LABEL"])
袋袋=recall_accuracy(as.numeric(as.factor(data$标题[z:y])),results[,"BAGGING_LABEL"])
向量机=recall_accuracy(as.numeric(as.factor(data$标题[z:y])),results[,"SVM_LABEL"])
神经网络=recall_accuracy(as.numeric(as.factor(data$标题[z:y])),results[,"NNETWORK_LABEL"])
a=c()
c=c()
e=c()
a=cbind( 随机森林=as.vector(results[,"FORESTS_LABEL"]),决策树=as.vector(results[,"TREE_LABEL"]) ,支持向量机=as.vector(results[,"SVM_LABEL"]),
        贝叶斯=as.vector(predicted),最大熵=as.vector(results[,"MAXENTROPY_LABEL"]),袋袋=as.vector(results[,"BAGGING_LABEL"]),
     神经网络=as.vector( results[,"NNETWORK_LABEL"]))
for(i in 1:length(results[,"FORESTS_LABEL"][z:y]))
{ 
  b=table(a[i,])
 c[i]<-names(which(b==max(table(a[i,]))))
    }
模型预测=cbind(a,组合模型=c)
A=table(data$标题[z:y],c)
b=length(which(c==data$标题[z:y]))/length(c)
组合模型=b
e=c(贝叶斯=b1,森林=森林,最大熵=最大熵,决策树=决策树,袋袋=袋袋,向量机=向量机,神经网络=神经网络,组合投票=组合模型)

 ##结果该满意了吧！！！

> e   贝叶斯      森林    最大熵    决策树      袋袋    向量机  神经网络  组合投票 0.4202899 1.0000000 1.0000000 0.5893720 1.0000000 0.3526570 0.9033816 1.0000000 

 四、文本聚类

文本聚类就没什么技术含量了，主要原因是其实非监督学习，效果一般不是很好。

data=t(mat[,1:50])
data.scale <- scale(data)
d <- dist(data.scale, method = "euclidean")
fit <- hclust(d, method="ward.D")

plot(fit,main="文本聚类")