R语言实现朴素贝叶斯中文文本分类

一、朴素贝叶斯及其原理。
    贝叶斯公式P(A|B) = P(B|A)*P(A)/P(B)   其中：P(A|B)  是B的后验概率，是我们计算出来的。 P(B)是先验概率，是统计出来的。同样P(B|A)*P(A)也是可以统计出来的。这样，贝叶斯公式提供了一种方法，让我们利用可以统计出来的先验概率推算出后验概率，而后验概率我们可以用来分类。
    假设 abcd表示四个单词出现在文章中这个事件。现在知道一篇文章中abcd出现的概率。求这篇文章的类别。我们可以依次计算文章属于各个类别的后验概率，然后取后验概率最大的类，作为该文章的类别。在求解后验概率的时候，会出现一个问题，就是计算量过于庞大。P(A|a,b,c,d) = P(a,b,c,d|A)*P(A)/P(a,b,c,d)  此时，P(a,b,c,d)和P(a,b,c,d|A)不容易统计出来。我们不可能每次去文章里扫描一遍，效率太低。也不容易根据P(a) P(b) P(c) P(d) 算出来，因为一篇文章中的单词出现的概率，是相互影响的，比如cs和电子竞技同时出现的可能性更大，此时不能简单的把他们的概率相乘。假设cs出现过的地方，电子竞技都出现了，他们出现的概率都是1/2，此时把他们相乘，就成了1/4，这是不对的。
   我们假设，各个单词出现在文章中的事件是相互独立的。既a出现和b出不出现没有关系。这时候上面的计算就简单了，直接相乘就可以了，同时我们只需要比较大小，而P(a,b,c,d)在各个类别后验概率计算的时候都是相等的，直接省略掉就行。由于相互独立,根据概率模型 P(a,b,c,d|A) = P(a|A)*P(b|A)*P(c|A)*P(d|A). 但是，这个假设明显是不成立的。所以这样的计算方式叫做天真贝叶斯，翻译过来就是朴素贝叶斯。如果不朴素，也能算，但是要复杂不少。尽管这个假设往往是不成立的，但是朴素贝叶斯仍然能够有好的效果。
二、具体例子
    在我们统计单词出现概率和文章属于哪一类的概率的时候，有不同的统计粒度。我们可以按单词为粒度统计，单词出现一次就算一次，而文章属于某类的概率算成文章词数除以总体的词数。这种方式叫做多项式模型。另一种方式是单词只要出现在文章中就算出现，不考虑单词出现次数，而文章的概率以文章的篇数除以总的篇数来算。这样的叫伯努利模型。
2.1多项式模型
1）基本原理
在多项式模型中， 设某文档d=(t1,t2,…,tk)，tk是该文档中出现过的单词，允许重复，则
先验概率P(c)= 类c下单词总数/整个训练样本的单词总数
类条件概率P(tk|c)=(类c下单词tk在各个文档中出现过的次数之和+1)/(类c下单词总数+|V|)
V是训练样本的单词表（即抽取单词，单词出现多次，只算一个），|V|则表示训练样本包含多少种单词。 P(tk|c)可以看作是单词tk在证明d属于类c上提供了多大的证据，而P(c)则可以认为是类别c在整体上占多大比例(有多大可能性)。
2）举例
给定一组分好类的文本训练数据，如下：
docId
doc
类别
In c=China?
1
Chinese Beijing Chinese
yes
2
Chinese Chinese Shanghai
yes
3
Chinese Macao
yes
4
Tokyo Japan Chinese
no
给定一个新样本Chinese Chinese Chinese Tokyo Japan，对其进行分类。该文本用属性向量表示为d=(Chinese, Chinese, Chinese, Tokyo, Japan)，类别集合为Y={yes, no}。
类yes下总共有8个单词，类no下总共有3个单词，训练样本单词总数为11，因此P(yes)=8/11, P(no)=3/11。类条件概率计算如下：
P(Chinese | yes)=(5+1)/(8+6)=6/14=3/7
P(Japan | yes)=P(Tokyo | yes)= (0+1)/(8+6)=1/14
P(Chinese|no)=(1+1)/(3+6)=2/9
P(Japan|no)=P(Tokyo| no) =(1+1)/(3+6)=2/9
分母中的8，是指yes类别下textc的长度，也即训练样本的单词总数，6是指训练样本有Chinese,Beijing,Shanghai, Macao, Tokyo, Japan 共6个单词，3是指no类下共有3个单词。
有了以上类条件概率，开始计算后验概率：
P(yes | d)=(3/7)3×1/14×1/14×8/11=108/184877≈0.00058417
P(no | d)= (2/9)3×2/9×2/9×3/11=32/216513≈0.00014780
比较大小，即可知道这个文档属于类别china。
2.2伯努利模型
1）基本原理
P(c)= 类c下文件总数/整个训练样本的文件总数
P(tk|c)=(类c下包含单词tk的文件数+1)/(类c下单词总数+2)
2）举例
使用前面例子中的数据，模型换成伯努利模型。
类yes下总共有3个文件，类no下有1个文件，训练样本文件总数为11，因此P(yes)=3/4, P(Chinese | yes)=(3+1)/(3+2)=4/5，条件概率如下：
P(Japan | yes)=P(Tokyo | yes)=(0+1)/(3+2)=1/5
P(Beijing | yes)= P(Macao|yes)= P(Shanghai |yes)=(1+1)/(3+2)=2/5
P(Chinese|no)=(1+1)/(1+2)=2/3
P(Japan|no)=P(Tokyo| no) =(1+1)/(1+2)=2/3
P(Beijing| no)= P(Macao| no)= P(Shanghai | no)=(0+1)/(1+2)=1/3
有了以上类条件概率，开始计算后验概率，
P(yes|d)=P(yes)×P(Chinese|yes)×P(Japan|yes)×P(Tokyo|yes)×(1-P(Beijing|yes))×(1-P(Shanghai|yes))×(1-P(Macao|yes))=3/4×4/5×1/5×1/5×(1-2/5)  ×(1-2/5)×(1-2/5)=81/15625≈0.005
P(no|d)= 1/4×2/3×2/3×2/3×(1-1/3)×(1-1/3)×(1-1/3)=16/729≈0.022
因此，这个文档不属于类别china。
在上面的例子中，之所以加上了1，2，或者|V|，是因为，有些单词在我们的统计中可能一次都没出现，但是在我们要进行分类的样本里是出现了的。如果你直接把概率算成0，那连乘之后，概率都为0，已经失去了意义。为了避免这种现象，我们把分子分母都加个常数，做平滑处理。这样算概率的时候才不会都为0 . 即使我们做了平滑处理，还是可能出现0，因为很多小数连乘，得到的概率本身就非常非常小，在计算机里不停的舍去精度，最后都变成了0. 此时可以对计算的概率取对数。 因为我们只比较大小，取对数之后大小关系是不会改变的。log(a*b*c*d) = log(a)+log(b)+log(c)+log(d), 这时候就不会出现下溢出。
三、R语言实现
    我使用R语言实现了两遍。第一遍是对数码类产品的文章进行分类。效果不是特别理想，尤其是手机和MP3类别的文章错判的概率太大。感觉是手机和MP3中出现的屏幕、清晰度等词汇在相机类别下也出现的很多。家用电器类和电脑类就没有什么错判。因为文章第一行都是爬虫抓来的数据来源，所以都给去掉了。
    为了搞清楚代码是不是写对了，对代码稍作修改，对另外一组体育类新闻进行了分类。结果又出问题了，在乘以先验概率后，几乎所有的类别都判成了游泳。结果，我把条件概率不乘以先验概率，分类的正确率达到了98%，当然测试数据比较少。对体育类分类的时候，还改进了一点代码，就是不把文章整个存下来了，只存了table，也就是单词出现的次数。至于去除停止词，之前没有加上，程序运行速度贼快，加上去除停止词之后，速度就巨慢了，希望分词包以后能提供这个功能，在分词的时候就去掉stopwords . 不过我加上之后，对数码的分类效果确实有帮助。
<code>library(Rwordseg) #加载分词工具包  该包需要安装java 和Rjava
#加载停止词
stopwords <- readLines("D:\\baiduyundownload\\ml\\R\\my_stopword.txt",encoding="UTF-8")
#去除停止词的方法
removeStopword <- function(x,stopwords){
  return(x[!(x %in% stopwords)])
}
 
#将文件读成单词向量
readAll <- function(dir,stopwords){
  files <- list.files(dir)
  words <- c()
  for(file in files){
    lines <- readLines(paste(dir,file,sep="\\"),encoding="UTF-8")
    lines <- lines[-1]
    temp <- unlist(segmentCN(lines))
    temp <- removeStopword(temp,stopwords)
    words <- append(words,temp)
  }
  return(words)
}
 
dir <- "D:\\baiduyundownload\\ml\\R\\digital\\camera"
camera <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\digital\\computer"
computer <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\digital\\household"
household <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\digital\\mobile"
mobile <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\digital\\MP3"
MP3 <- readAll(dir,stopwords)
 
model <- list("camera"=camera,"computer"=computer,"household"=household,"mobile"=mobile,
  "MP3"=MP3)
#save(model,file="D:model.RData") 因为读取所有文本在R里非常慢，可以考虑把模型存起来
#下次要使用的时候load("D:model.RData"),就会自动有model对象数据分析培训
 
#先验概率
xianyan <- function(model,class){
  x <- sapply(model,length)
  total <- sum(x)
  y <- x[class]
  ret <- y/total
  names(ret) <- class
  return(ret)
}
#条件概率
tiaojian <- function(model,class,words){
  wordSet <- model[class]
  table <- table(wordSet)
  x <- table[words]
  x[is.na(x)] <- 0
  x <- x + 1
  y <- length(wordSet)+length(table)
  return(sum(log(x/y)))
  #return(prod(x/y))
}
 
#多项式分类
duoxiangshi <- function(dir,fileName,model,stopwords){
  lines <- readLines(paste(dir,file,sep="\\"),encoding="UTF-8")
  lines <- lines[-1]
  article <- unlist(segmentCN(lines))
  article <- removeStopword(article,stopwords)
 
  classes <- names(model)
  xianyanP <- xianyan(model,classes)
 
  maxP <- -Inf
  calculateClass <- ""
  for(class in classes){
    temp <- xianyanP[class]*tiaojian(model,class,article)
    if(maxP <= temp){
      maxP <- temp
      calculateClass <- class
    }
  }
  cat(fileName," is classified to ",calculateClass,"\n")
}
 
dir <- "D:\\baiduyundownload\\ml\\R\\test"
files <- list.files(dir)
for(file in files){
  duoxiangshi(dir,file,model,stopwords)
}</code>

下面是体育类
<code>library(Rwordseg)
#添加从搜狗上下载的txt词库，注意要是UTF-8 或者GBK编码的，直接下载的是ansi编码的，没用
#另外可以直接安装搜狗scel词库，改一下dicttype即可。词库一旦安装，以后R里都可以用，不用每次都安装
installDict(dictpath="D:\\baiduyundownload\\ml\\R\\f1专用词库.txt",dictname="f1",
 dicttype="text")
installDict(dictpath="D:\\baiduyundownload\\ml\\R\\篮球词库.txt",dictname="basketball",
 dicttype="text")
installDict(dictpath="D:\\baiduyundownload\\ml\\R\\乒乓球.txt",dictname="pingpong",
 dicttype="text")
installDict(dictpath="D:\\baiduyundownload\\ml\\R\\斯诺克.txt",dictname="snok",
 dicttype="text")
installDict(dictpath="D:\\baiduyundownload\\ml\\R\\体育爱好者.txt",dictname="sports",
 dicttype="text")
installDict(dictpath="D:\\baiduyundownload\\ml\\R\\网球词汇.txt",dictname="vollyball",
 dicttype="text")
installDict(dictpath="D:\\baiduyundownload\\ml\\R\\足球词汇大全.txt",dictname="football",
 dicttype="text")
 
#卸载词库
#uninstallDict(removedict='f1')
 
stopwords <- readLines("D:\\baiduyundownload\\ml\\R\\my_stopword.txt",encoding="UTF-8")
 
removeStopword <- function(x,stopwords){
  return(x[!(x %in% stopwords)])
}
 
#将文件读成 单词统计table
readAll <- function(dir,stopwords){
  files <- list.files(dir)
  words <- c()
  for(file in files){
    lines <- scan(paste(dir,file,sep="\\"),what=list(""),encoding="UTF-8")
    temp <- unlist(segmentCN(unlist(lines)))
    temp <- removeStopword(temp,stopwords)
    words <- append(words,temp)
  }
  return(table(words))
}
 
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\badminton"
badminton <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\basketball"
basketball <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\billiards"
billiards <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\f1"
f1 <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\football"
football <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\golf"
golf <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\pingpong"
pingpong <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\swim"
swim <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\tennis"
tennis <- readAll(dir,stopwords)
dir <- "D:\\baiduyundownload\\ml\\R\\sport\\volleyball"
volleyball <- readAll(dir,stopwords)
 
model <- list("badminton"=badminton,"basketball"=basketball,
  "billiards"=billiards,"f1"=f1,"football"=football,"golf"=golf,
  "pingpong"=pingpong,"swim"=swim,"tennis"=tennis,"volleyball"=volleyball)
save(model,file="D:sport.RData")
 
#计算先验概率，返回的是向量，每个文章类别的先验概率
xianyan <- function(model,class){
  x <- sapply(model,sum)
  total <- sum(x)
  y <- x[class]
  ret <- y/total
  names(ret) <- class
  return(ret)
}
#传入一个单词和类别，返回条件概率
tiaojian <- function(model,class,words){
  table <- model[[class]]
  x <- table[words]
  x[is.na(x)] <- 0
  x <- x + 1
  y <- sum(table)+length(table)
  return(sum(log(x/y)))
  #return(prod(x/y))  连乘会下溢出，边成0
}
 
#进行多项式分类
duoxiangshi <- function(dir,fileName,model,stopwords){
  lines <- scan(paste(dir,file,sep="\\"),what=list(""),encoding="UTF-8")
  article <- unlist(segmentCN(lines[[1]]))
  article <- removeStopword(article,stopwords)
 
  classes <- names(model)
  xianyanP <- xianyan(model,classes)
 
  maxP <- -Inf
  calculateClass <- ""
  for(class in classes){
    #temp <- xianyanP[class]*tiaojian(model,class,article)  这里不乘先验概率效果更好
    #也许应该考虑伯努利模型，按文档算，我的先验概率应该是一样的
    temp <- tiaojian(model,class,article)
    if(maxP <= temp){
      maxP <- temp
      calculateClass <- class
    }
  }
  cat(fileName," is classified to ",calculateClass,"\n")
}
 
dir <- "D:\\baiduyundownload\\ml\\R\\test2"
files <- list.files(dir)
for(file in files){
  duoxiangshi(dir,file,model,stopwords)
}</code>
分类结果如下：
badminton11 (1).txt  is classified to  badminton
badminton11 (2).txt  is classified to  badminton
badminton11 (3).txt  is classified to  badminton
badminton11 (4).txt  is classified to  badminton
badminton11 (5).txt  is classified to  badminton
badminton11 (6).txt  is classified to  badminton
basket21.txt  is classified to  basketball
basket22.txt  is classified to  basketball
basket23.txt  is classified to  basketball
basket24.txt  is classified to  basketball
basket25.txt  is classified to  basketball
basket26.txt  is classified to  basketball
basket27.txt  is classified to  basketball
f1 (1).txt  is classified to  f1
f1 (2).txt  is classified to  f1
f1 (3).txt  is classified to  f1
f1 (4).txt  is classified to  f1
f1 (5).txt  is classified to  f1………………………………