R语言进行中文分词和聚类

目标：对大约6w条微博进行分类

环境：R语言

由于时间较紧，且人手不够，不能采用分类方法，主要是没有时间人工分类一部分生成训练集……所以只能用聚类方法，聚类最简单的方法无外乎：K-means与层次聚类。

尝试过使用K-means方法，但结果并不好，所以最终采用的是层次聚类，也幸亏结果还不错……⊙﹏⊙

分词（Rwordseg包）：

分词采用的是Rwordseg包，具体安装和一些细节请参考作者首页 。请仔细阅读该页提供的使用说明pdf文档，真是有很大帮助。

• 安装：

P.S.

由于我是64位机，但是配置的rj包只能在32bit的R上使用，而且Rwordseg包貌似不支持最新版本的R（3.01），所以请在32bit的R.exe（2.15）中运行如下语句安装0.0-4版本：

install.packages("Rwordseg", repos = "http://R-Forge.R-project.org")

貌似直接在Rstudio中运行会安装失败，而且直接在Rstudio中点击install安装，安装的是0.0-5版本，我就一直失败……

• 使用：

1. 分词时尽量关闭人名识别

   segmentCN(doc,recognition=F)

   否则会将“中秋国庆”，分为“中”“秋国庆“

2. 可以使用insertWords()函数添加临时的词汇
3. 对文档向量进行分词时，强烈建议用for循环对每一个元素执行segmentCN，而不要对整个向量执行！！！因为我蛋疼的发现对整个向量执行时，还是会出现识别人名的现象……
4. 运行完后请detach()包，removeWords()函数与tm包中的同名函数冲突。

微博分词的一些建议：

1. 微博内容中经常含有url，分词后会将url拆散当做英文单词处理，所以我们需要用正则表达式，将url去掉：

   gsub(pattern="http:[a-zA-Z\\/\\.0-9]+","",doc)

2. 微博中含有#标签#，可以尽量保证标签的分词准确，可以先提取标签，然后用insertWords()人工添加一部分词汇：

   library("stringr")
   tag=str_extract(doc,"^#.+?#")  #以“#”开头，“."表示任意字符，"+"表示前面的字符至少出现一次，"?"表示不采用贪婪匹配—即之后遇到第一个#就结束
   tag=na.omit(tag)  #去除NA
   tag=unique(tag)    #去重

文本挖掘（tm包）：

• 语料库：

分词之后生成一个列表变量，用列表变量构建语料库。

由于tm包中的停用词都是英文（可以输入stopwords()查看），所以大家可以去网上查找中文的停用词（一般700多个的就够了，还有1208个词版本的），用removeWords函数去除语料库中的停用词：

doc.corpus=tm_map(doc.corpus,removeWords,stopwords_CN)

• TDM：

生成语料库之后，生成词项-文档矩阵（Term Document Matrix，TDM），顾名思义，TDM是一个矩阵，矩阵的列对应语料库中所有的文档，矩阵的行对应所有文档中抽取的词项，该矩阵中，一个[i,j]位置的元素代表词项i在文档j中出现的次数。

由于tm包是对英文文档就行统计挖掘的，所以生成TDM时会对英文文档进行分词（即使用标点和空格分词），之前Rwordseg包做的就是将中文语句拆分成一个个词，并用空格间隔。

创建TDM的语句为：

control=list(removePunctuation=T,minDocFreq=5,wordLengths = c(1, Inf),weighting = weightTfIdf)
doc.tdm=TermDocumentMatrix(doc.corpus,control)

变量control是一个选项列表，控制如何抽取文档，removePunctuation表示去除标点，minDocFreq=5表示只有在文档中至少出现5次的词才会出现在TDM的行中。

tm包默认TDM中只保留至少3个字的词（对英文来说比较合适，中文就不适用了吧……），wordLengths = c(1, Inf)表示字的长度至少从1开始。

默认的加权方式是TF，即词频，这里采用Tf-Idf，该方法用于评估一字词对于一个文件集或一个语料库中的其中一份文件的重要程度：

1. 在一份给定的文件里，词频 (term frequency, TF) 指的是某一个给定的词语在该文件中出现的次数。这个数字通常会被归一化，以防止它偏向长的文件。（同一个词语在长文件里可能会比短文件有更高的词频，而不管该词语重要与否。）
2. 逆向文件频率 (inverse document frequency, IDF) 是一个词语普遍重要性的度量。某一特定词语的IDF，可以由总文件数目除以包含该词语之文件的数目，再将得到的商取对数得到。
3. 某一特定文件内的高词语频率，以及该词语在整个文件集合中的低文件频率，可以产生出高权重的TF-IDF。因此，TF-IDF倾向于保留文档中较为特别的词语，过滤常用词。

由于TDM大多都是稀疏的，需要用removeSparseTerms()函数(:"A term-document matrix where those terms fromxare removed which have at least asparsepercentage of empty")进行降维，值需要不断的测试，我一般会使词项减少到原有的一半。

层次聚类：

层次聚类的核心实际在距离矩阵的计算，一般聚类时会使用欧氏距离、闵氏距离等，但在大型数据条件下会优先选择 cosine 距离，及 dissmilarity 函数：

dissimilarity(tdm_removed, method = 'cosine')

（P.S.要使用cosine方法，需要先安装proxy包。）

层次聚类的方法也有很多，这里选用mcquitty，大家还是多试试，本文给出的选择不一定适合你~

注意：由于R对向量的大小有限制，所以在计算距离时，请优先使用64bit，3.0版本的R~

但如果出现如下报错信息：

"Error in vector(typeof(x$v), nr * nc) : vector size cannot be NA
In addition: Warning message:
In nr * nc : NAs produced by integer overflow"

恭喜你！这个问题64位版本的R也解决不了，因为矩阵超出了R允许的最大限制~我也是遇到同样的问题，所以没办法，只能将原始数据进行拆分，不过我的情况是多个微博账户，但彼此之间的微博分类差不太多，所以可以进行拆分。强烈推荐大家有问题去查找！

（我看到有外国友人说可以用int64包尝试一下，因为tdm其实也是个list，但我没试成功……）

好了，下面贴上全部代码：

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

# 读取数据
col=c(rep("character",6),"NULL",NA,NA,"character",rep("NULL",4))
data=read.csv(file="text.csv",header=T,sep=",",colClasses=col) 
# 将文本存储到一个向量中
doc=c(NULL)
for(i in 1:dim(data)[1]){
  doc=c(doc,data$Text[i])
}

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

# 去除微博中含有的url
doc=gsub(pattern="http:[a-zA-Z\\/\\.0-9]+","",doc)

# 无意义微博处理
empty_N=c(2032,2912,7518,8939,14172,14422,26786,30126,34501,35239,48029,48426,48949,49100,49365,49386,49430,50034,56818,56824,56828,57859)
doc[empty_N]="NA"

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

# 添加词汇

library("Rwordseg")
textwords=c("...")
insertWords(textwords)
# removeWords(tagwords)

doc_CN=list()
for(j in 1:length(doc)){
  doc_CN[[j]]=c(segmentCN(doc[j],recognition=F))
}

detach("package:Rwordseg", unload=TRUE)

#################################################################
# 构建语料库(Corpus对象)
library("tm")
doc.corpus=Corpus(VectorSource(doc_CN))

###########停用词###########
data_stw=read.table(file="中文停用词库.txt",colClasses="character")
stopwords_CN=c(NULL)
for(i in 1:dim(data_stw)[1]){
  stopwords_CN=c(stopwords_CN,data_stw[i,1])
}
doc.corpus=tm_map(doc.corpus,removeWords,stopwords_CN) # 删除停用词
############################

# 创建词项-文档矩阵(TDM)
control=list(removePunctuation=T,minDocFreq=5,wordLengths = c(1, Inf),weighting = weightTfIdf)
doc.tdm=TermDocumentMatrix(doc.corpus,control)

length(doc.tdm$dimnames$Terms)
tdm_removed=removeSparseTerms(doc.tdm, 0.9998) # 1-去除了低于 99.98% 的稀疏条目项
length(tdm_removed$dimnames$Terms)

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

# 层次聚类：
dist_tdm_removed <- dissimilarity(tdm_removed, method = 'cosine')
hc <- hclust(dist_tdm_removed, method = 'mcquitty')
cutNum = 20
ct = cutree(hc,k=cutNum)
sink(file="result.txt")
for(i in 1:cutNum){
  print(paste("第",i,"类： ",sum(ct==i),"个"));
  print("----------------");
  print(attr(ct[ct==i],"names"));
#   print(doc[as.integer(names(ct[ct==i]))])
  print("----------------")
}
sink()


#输出结果
output=data.frame(clas=NULL,tag=NULL,text=NULL)
for(i in 1:cutNum){
  in_tag=tag[as.integer(names(ct[ct==i]))]
  in_text=doc[as.integer(names(ct[ct==i]))]
  cut_output=data.frame(clas=rep(i,length(in_tag)),tag=in_tag,text=in_text)
  output=rbind(output,cut_output)
}
write.table(output,file="classification.csv",sep=",",row.names=F)