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)