####需要先安装几个R包，如果有这些包，可省略安装包的步骤。
#install.packages("Rwordseg")
#install.packages("tm");
#install.packages("wordcloud");
#install.packages("topicmodels")
例子中所用数据
数据来源于sougou实验室数据。
数据网址：http://download.labs.sogou.com/dl/sogoulabdown/SogouC.mini.20061102.tar.gz
文件结构
└─Sample
├─C000007?汽车
├─C000008?财经
├─C000010 IT
├─C000013?健康
├─C000014?体育
├─C000016?旅游
├─C000020?教育
├─C000022?招聘
├─C000023
└─C000024?军事
采用Python对数据进行预处理为train.csv文件，并把每个文件文本数据处理为1行。
预处理python脚本
#!/usr/bin/env python
#encoding=utf-8
from glob import glob
import os,sys,csv
def cur_file_dir():
path = sys.path[0]
if os.path.isdir(path):
return path
elif os.path.isfile(path):
return os.path.dirname(path)
FILE_TRAIN= cur_file_dir() + os.sep + 'train.csv'
csvfile = open(FILE_TRAIN,'w')
writer = csv.writer(csvfile)
writer.writerow(['type','text'])
csvfile.flush()
try:
file_names = glob('.Sample**.txt')
for file_name in file_names:
if file_name.find("C000007") > -1:
file_type ="yy"
elif file_name.find("C000008") > -1:
file_type = "yy"
elif file_name.find("C000010") > -1:
file_type = "yy"
elif file_name.find("C000013") > -1:
file_type = "yy"
elif file_name.find("C000014") > -1:
file_type = "yy"
elif file_name.find("C000016") > -1:
file_type = "yy"
elif file_name.find("C000020") > -1:
file_type = "yy"
elif file_name.find("C000022") > -1:
file_type = "yy"
elif file_name.find("C000023") > -1:
file_type = "yy"
elif file_name.find("C000024") > -1:
file_type = "yy"
textFile = open(file_name,'r',encoding= 'utf-8')
lines = textFile.readlines()
texts = " ".join(lines).strip().replace('"',"").replace("'","").replace("n","").replace("r","").replace("?","")
writer.writerow([file_type,texts])
csvfile.flush()
textFile.close
finally:
csvfile.close()
所需数据
大家也可以用R直接将原始数据转变成train.csv中的数据
文章所需stopwords
1.读取资料库
csv <- read.csv("d://wb//train.csv",header=T,stringsAsFactors=F)
mystopwords<- unlist (read.table("d://wb//StopWords.txt",stringsAsFactors=F))
2.数据预处理（中文分词、stopwords处理）
library(tm);
#移除数字
removeNumbers = function(x) { ret = gsub("[0-9０１２３４５６７８９]","",x) }
sample.words <- lapply(csv$$$$text,removeNumbers)
#处理中文分词,此处用到Rwordseg包
wordsegment<- function(x) {
library(Rwordseg)
segmentCN(x)
}
sample.words <- lapply(sample.words,wordsegment)
###stopwords处理
###先处理中文分词，再处理stopwords，防止全局替换丢失信息
removeStopWords = function(x,words) {
ret = character(0)
index <- 1
it_max <- length(x)
while (index <= it_max) {
if (length(words[words==x[index]]) <1) ret <- c(ret,x[index])
index <- index +1
}
ret
}
sample.words <- lapply(sample.words,removeStopWords,mystopwords)
3.wordcloud展示
#构建语料库
corpus = Corpus(VectorSource(sample.words))
meta(corpus,"cluster") <- csv$type
unique_type <- unique(csv$type)
#建立文档-词条矩阵
(sample.dtm <- DocumentTermMatrix(corpus,control = list(wordLengths = c(2,Inf))))
#install.packages("wordcloud"); ##需要wordcloud包的支持
library(wordcloud);
#不同文档wordcloud对比图
sample.tdm <- TermDocumentMatrix(corpus,Inf)));
tdm_matrix <- as.matrix(sample.tdm);
png(paste("d://wb//sample_comparison",".png",sep = ""),width = 1500,height = 1500 );
comparison.cloud(tdm_matrix,colors=rainbow(ncol(tdm_matrix)));####由于颜色问题，稍作修改
title(main = "sample comparision");
dev.off();
#按分类汇总wordcloud对比图
n <- nrow(csv)
zz1 = 1:n
cluster_matrix<-sapply(unique_type,function(type){apply(tdm_matrix[,zz1[csv$$$$type==type]],1,sum)})
png(paste("d://wb//sample_ cluster_comparison",width = 800,height = 800 )
comparison.cloud(cluster_matrix,colors=brewer.pal(ncol(cluster_matrix),"Paired")) ##由于颜色分类过少，此处稍作修改
title(main = "sample cluster comparision")
dev.off()
#按各分类画wordcloud
sample.cloud <- function(cluster,maxwords = 100) {
words <- sample.words[which(csv$type==cluster)]
allwords <- unlist(words)
wordsfreq <- sort(table(allwords),decreasing = T)
wordsname <- names(wordsfreq)
png(paste("d://wb//sample_",cluster,width = 600,height = 600 )
wordcloud(wordsname,wordsfreq,scale = c(6,1.5),min.freq = 2,max.words = maxwords,colors = rainbow(100))
title(main = paste("cluster:",cluster))
dev.off()
}
lapply(unique_type,sample.cloud)# unique(csv$type)
4.主题模型分析
library(slam)
summary(col_sums(sample.dtm))
term_tfidf <- tapply(sample.dtm$v/row_sums( sample.dtm)[ sample.dtm$i],sample.dtm$j,mean)*
log2(nDocs( sample.dtm)/col_sums( sample.dtm > 0))
summary(term_tfidf)
sample.dtm <- sample.dtm[,term_tfidf >= 0.1]
sample.dtm <- sample.dtm[row_sums(sample.dtm) > 0,]
##α估计严重小于默认值，这表明Dirichlet分布数据集中于部分数据，文档包括部分主题
library(topicmodels)
k <- 30
SEED <- 2010
sample_TM <-
list(
VEM = LDA(sample.dtm,k = k,control = list(seed = SEED)),VEM_fixed = LDA(sample.dtm,control = list(estimate.alpha = FALSE,seed = SEED)),Gibbs = LDA(sample.dtm,method = "Gibbs",control = list(seed = SEED,burnin = 1000,thin = 100,iter = 1000)),CTM = CTM(sample.dtm,var = list(tol = 10^-4),em = list(tol = 10^-3)))
)
sapply(sample_TM[1:2],slot,"alpha")
sapply(sample_TM,function(x) mean(apply(posterior(x)$topics,function(z) - sum(z * log(z)))))
α估计严重小于默认值，这表明Dirichlet分布数据集中于部分数据，文档包括部分主题。
数值越高说明主题分布更均匀
#最可能的主题文档
Topic <- topics(sample_TM[["VEM"]],1)
table(Topic)
#每个Topic前5个Term
Terms <- terms(sample_TM[["VEM"]],5)
Terms[,1:10]
######### auto中每一篇文章中主题数目
(topics_auto <-topics(sample_TM[["VEM"]])[ grep("auto",csv[[1]]) ])
most_frequent_auto <- which.max(tabulate(topics_auto))
######### 与auto主题最相关的10个词语
terms(sample_TM[["VEM"]],10)[,most_frequent_auto]
5.文本分类、无监督分类（包括系统聚类、KMeans、string kernals）
sample_matrix = as.matrix(sample.dtm)
rownames(sample_matrix) <- csv$type
#KMeans分类
sample_KMeans ?<- ?kmeans(sample_matrix,?k)
library(clue)
#计算最大共同分类率
cl_agreement(sample_KMeans,?as.cl_partition(csv$type),?"diag")
#string kernals
library("kernlab")
stringkern ?<- ?stringdot(type ?= ?"string")
stringC1 <- specc(corpus,10,kernel=stringkern)
#查看统计效果
table("String ?Kernel"=stringC1,?cluster = csv$type )
6.文本分类，有监督分类（包括knn、SVM）
把数据随机抽取90%作为学习集，剩下10%作为测试集。实际应用中应该进行交叉检验，这里简单起见，只进行一次抽取。
n <- nrow(csv)
set.seed(100)
zz1 <- 1:n
zz2 <- rep(1:k,ceiling(n/k))[1:n] #k <- length(unique(csv$type))
zz2 <- sample(zz2,n)
train <- sample_matrix[zz2<10,]
test <- sample_matrix[zz2==10,]
trainC1 <- as.factor(rownames(train))
#knn分类
library(class)
sample_knnCl ?<- ?knn(train,test,trainC1)
trueC1 <- as.factor(rownames(test))
#查看预测结果
(nnTable ?<- ?table("1-NN" = sample_knnCl,?sample = ?trueC1))
sum(diag(nnTable))/nrow(test)
#样本集少预测效果是不好
#SVM分类
rownames(train) <- NULL
train <- as.data.frame(train)
train$type <- trainC1
sample_ksvm ?<- ?ksvm(type~.,data=train)
svmCl ?<- ?predict(sample_ksvm,test)
(svmTable <-table(SVM=svmCl,sample=trueC1))
sum(diag(svmTable))/nrow(test)
Rwordseg 中文词汇分类工具包
该包与你用的R 版本有一些关系。可以参考下面这个链接说明
http://www.biostatistic.net/foru ... hread&tid=94955
|
