R語言實(shí)現(xiàn)樸素貝葉斯中文文本分類

一、樸素貝葉斯及其原理。
    貝葉斯公式P(A|B) = P(B|A)*P(A)/P(B)   其中：P(A|B)  是B的后驗(yàn)概率，是我們計(jì)算出來的。 P(B)是先驗(yàn)概率，是統(tǒng)計(jì)出來的。同樣P(B|A)*P(A)也是可以統(tǒng)計(jì)出來的。這樣，貝葉斯公式提供了一種方法，讓我們利用可以統(tǒng)計(jì)出來的先驗(yàn)概率推算出后驗(yàn)概率，而后驗(yàn)概率我們可以用來分類。
    假設(shè) abcd表示四個(gè)單詞出現(xiàn)在文章中這個(gè)事件?，F(xiàn)在知道一篇文章中abcd出現(xiàn)的概率。求這篇文章的類別。我們可以依次計(jì)算文章屬于各個(gè)類別的后驗(yàn)概率，然后取后驗(yàn)概率最大的類，作為該文章的類別。在求解后驗(yàn)概率的時(shí)候，會(huì)出現(xiàn)一個(gè)問題，就是計(jì)算量過于龐大。P(A|a,b,c,d) = P(a,b,c,d|A)*P(A)/P(a,b,c,d)  此時(shí)，P(a,b,c,d)和P(a,b,c,d|A)不容易統(tǒng)計(jì)出來。我們不可能每次去文章里掃描一遍，效率太低。也不容易根據(jù)P(a) P(b) P(c) P(d) 算出來，因?yàn)橐黄恼轮械膯卧~出現(xiàn)的概率，是相互影響的，比如cs和電子競技同時(shí)出現(xiàn)的可能性更大，此時(shí)不能簡單的把他們的概率相乘。假設(shè)cs出現(xiàn)過的地方，電子競技都出現(xiàn)了，他們出現(xiàn)的概率都是1/2，此時(shí)把他們相乘，就成了1/4，這是不對(duì)的。
   我們假設(shè)，各個(gè)單詞出現(xiàn)在文章中的事件是相互獨(dú)立的。既a出現(xiàn)和b出不出現(xiàn)沒有關(guān)系。這時(shí)候上面的計(jì)算就簡單了，直接相乘就可以了，同時(shí)我們只需要比較大小，而P(a,b,c,d)在各個(gè)類別后驗(yàn)概率計(jì)算的時(shí)候都是相等的，直接省略掉就行。由于相互獨(dú)立,根據(jù)概率模型 P(a,b,c,d|A) = P(a|A)*P(b|A)*P(c|A)*P(d|A). 但是，這個(gè)假設(shè)明顯是不成立的。所以這樣的計(jì)算方式叫做天真貝葉斯，翻譯過來就是樸素貝葉斯。如果不樸素，也能算，但是要復(fù)雜不少。盡管這個(gè)假設(shè)往往是不成立的，但是樸素貝葉斯仍然能夠有好的效果。
二、具體例子
    在我們統(tǒng)計(jì)單詞出現(xiàn)概率和文章屬于哪一類的概率的時(shí)候，有不同的統(tǒng)計(jì)粒度。我們可以按單詞為粒度統(tǒng)計(jì)，單詞出現(xiàn)一次就算一次，而文章屬于某類的概率算成文章詞數(shù)除以總體的詞數(shù)。這種方式叫做多項(xiàng)式模型。另一種方式是單詞只要出現(xiàn)在文章中就算出現(xiàn)，不考慮單詞出現(xiàn)次數(shù)，而文章的概率以文章的篇數(shù)除以總的篇數(shù)來算。這樣的叫伯努利模型。
2.1多項(xiàng)式模型
1）基本原理
在多項(xiàng)式模型中， 設(shè)某文檔d=(t1,t2,…,tk)，tk是該文檔中出現(xiàn)過的單詞，允許重復(fù)，則
先驗(yàn)概率P(c)= 類c下單詞總數(shù)/整個(gè)訓(xùn)練樣本的單詞總數(shù)
類條件概率P(tk|c)=(類c下單詞tk在各個(gè)文檔中出現(xiàn)過的次數(shù)之和+1)/(類c下單詞總數(shù)+|V|)
V是訓(xùn)練樣本的單詞表（即抽取單詞，單詞出現(xiàn)多次，只算一個(gè)），|V|則表示訓(xùn)練樣本包含多少種單詞。 P(tk|c)可以看作是單詞tk在證明d屬于類c上提供了多大的證據(jù)，而P(c)則可以認(rèn)為是類別c在整體上占多大比例(有多大可能性)。
2）舉例
給定一組分好類的文本訓(xùn)練數(shù)據(jù)，如下：
docId
doc
類別
In c=China?
1
Chinese Beijing Chinese
yes
2
Chinese Chinese Shanghai
yes
3
Chinese Macao
yes
4
Tokyo Japan Chinese
no
給定一個(gè)新樣本Chinese Chinese Chinese Tokyo Japan，對(duì)其進(jìn)行分類。該文本用屬性向量表示為d=(Chinese, Chinese, Chinese, Tokyo, Japan)，類別集合為Y={yes, no}。
類yes下總共有8個(gè)單詞，類no下總共有3個(gè)單詞，訓(xùn)練樣本單詞總數(shù)為11，因此P(yes)=8/11, P(no)=3/11。類條件概率計(jì)算如下：
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的長度，也即訓(xùn)練樣本的單詞總數(shù)，6是指訓(xùn)練樣本有Chinese,Beijing,Shanghai, Macao, Tokyo, Japan 共6個(gè)單詞，3是指no類下共有3個(gè)單詞。
有了以上類條件概率，開始計(jì)算后驗(yàn)概率：
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
比較大小，即可知道這個(gè)文檔屬于類別china。
2.2伯努利模型
1）基本原理
P(c)= 類c下文件總數(shù)/整個(gè)訓(xùn)練樣本的文件總數(shù)
P(tk|c)=(類c下包含單詞tk的文件數(shù)+1)/(類c下單詞總數(shù)+2)
2）舉例
使用前面例子中的數(shù)據(jù)，模型換成伯努利模型。
類yes下總共有3個(gè)文件，類no下有1個(gè)文件，訓(xùn)練樣本文件總數(shù)為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
有了以上類條件概率，開始計(jì)算后驗(yàn)概率，
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
因此，這個(gè)文檔不屬于類別china。
在上面的例子中，之所以加上了1，2，或者|V|，是因?yàn)?，有些單詞在我們的統(tǒng)計(jì)中可能一次都沒出現(xiàn)，但是在我們要進(jìn)行分類的樣本里是出現(xiàn)了的。如果你直接把概率算成0，那連乘之后，概率都為0，已經(jīng)失去了意義。為了避免這種現(xiàn)象，我們把分子分母都加個(gè)常數(shù)，做平滑處理。這樣算概率的時(shí)候才不會(huì)都為0 . 即使我們做了平滑處理，還是可能出現(xiàn)0，因?yàn)楹芏嘈?shù)連乘，得到的概率本身就非常非常小，在計(jì)算機(jī)里不停的舍去精度，最后都變成了0. 此時(shí)可以對(duì)計(jì)算的概率取對(duì)數(shù)。 因?yàn)槲覀冎槐容^大小，取對(duì)數(shù)之后大小關(guān)系是不會(huì)改變的。log(a*b*c*d) = log(a)+log(b)+log(c)+log(d), 這時(shí)候就不會(huì)出現(xiàn)下溢出。
三、R語言實(shí)現(xiàn)
    我使用R語言實(shí)現(xiàn)了兩遍。第一遍是對(duì)數(shù)碼類產(chǎn)品的文章進(jìn)行分類。效果不是特別理想，尤其是手機(jī)和MP3類別的文章錯(cuò)判的概率太大。感覺是手機(jī)和MP3中出現(xiàn)的屏幕、清晰度等詞匯在相機(jī)類別下也出現(xiàn)的很多。家用電器類和電腦類就沒有什么錯(cuò)判。因?yàn)槲恼碌谝恍卸际桥老x抓來的數(shù)據(jù)來源，所以都給去掉了。
    為了搞清楚代碼是不是寫對(duì)了，對(duì)代碼稍作修改，對(duì)另外一組體育類新聞進(jìn)行了分類。結(jié)果又出問題了，在乘以先驗(yàn)概率后，幾乎所有的類別都判成了游泳。結(jié)果，我把條件概率不乘以先驗(yàn)概率，分類的正確率達(dá)到了98%，當(dāng)然測試數(shù)據(jù)比較少。對(duì)體育類分類的時(shí)候，還改進(jìn)了一點(diǎn)代碼，就是不把文章整個(gè)存下來了，只存了table，也就是單詞出現(xiàn)的次數(shù)。至于去除停止詞，之前沒有加上，程序運(yùn)行速度賊快，加上去除停止詞之后，速度就巨慢了，希望分詞包以后能提供這個(gè)功能，在分詞的時(shí)候就去掉stopwords . 不過我加上之后，對(duì)數(shù)碼的分類效果確實(shí)有幫助。
<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") 因?yàn)樽x取所有文本在R里非常慢，可以考慮把模型存起來
#下次要使用的時(shí)候load("D:model.RData"),就會(huì)自動(dòng)有model對(duì)象數(shù)據(jù)分析培訓(xùn)
 
#先驗(yàn)概率
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))
}
 
#多項(xiàng)式分類
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\\網(wǎng)球詞匯.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)])
}
 
#將文件讀成 單詞統(tǒng)計(jì)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")
 
#計(jì)算先驗(yàn)概率，返回的是向量，每個(gè)文章類別的先驗(yàn)概率
xianyan <- function(model,class){
  x <- sapply(model,sum)
  total <- sum(x)
  y <- x[class]
  ret <- y/total
  names(ret) <- class
  return(ret)
}
#傳入一個(gè)單詞和類別，返回條件概率
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))  連乘會(huì)下溢出，邊成0
}
 
#進(jìn)行多項(xiàng)式分類
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)  這里不乘先驗(yàn)概率效果更好
    #也許應(yīng)該考慮伯努利模型，按文檔算，我的先驗(yàn)概率應(yīng)該是一樣的
    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>
分類結(jié)果如下：
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………………………………