文本預處理
1.設置路徑
setwd("e://r語言學習//r代碼")
2.加載詞典
installDict("D:\\R\\sources\\Dictionaries\\news.scel",dictname = "news1")
installDict("D:\\R\\sources\\Dictionaries\\news2.scel",dictname = "news2")
listDict()
3.加載文檔
data <-readLines("d:\\R\\RWorkspace\\fhnews.txt",encoding ="UTF-8")
4.去除特殊詞
dataTemp <- gsub("[0-9０１２３４５６７８９ < > ~]","",data)
5.分詞
dataTemp <- segmentCN(dataTemp)
dataTemp[1:2]
6.去除停用詞
stopwords<- unlist(read.table("D:\\R\\RWorkspace\\StopWords.txt",stringsAsFactors=F))
stopwords[50:100]
removeStopWords <- function(x,stopwords) {
temp <- character(0)
index <- 1
xLen <- length(x)
while (index <= xLen) {
if (length(stopwords[stopwords==x[index]]) <1)
temp<- c(temp,x[index])
index <- index +1
}
temp
}
> dataTemp2 <-lapply(dataTemp,removeStopWords,stopwords)
> dataTemp2[1:2]
文本分類
通過詞頻的余弦相似度做文本分類
1.加載語料庫
library("tm")
reuters =VCorpus(VectorSource(doc_CN))
reuters <- tm_map(reuters, stripWhitespace)
2.刪除停用詞
data_stw<- unlist (read.table("E:\\text mining\\stopword\\中文停用詞.txt",stringsAsFactors=F))
#head(data_stw,n=10)
reuters=tm_map(reuters,removeWords,data_stw)
3.生成TF-IDF特征
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="文本聚類")
