R語言實現樸素貝葉斯中文文本分類

一、樸素貝葉斯及其原理。
    貝葉斯公式P(A|B) = P(B|A)*P(A)/P(B)   其中：P(A|B)  是B的后驗概率，是我們計算出來的。 P(B)是先驗概率，是統計出來的。同樣P(B|A)*P(A)也是可以統計出來的。這樣，貝葉斯公式提供了一種方法，讓我們利用可以統計出來的先驗概率推算出后驗概率，而后驗概率我們可以用來分類。
    假設 abcd表示四個單詞出現在文章中這個事件?，F在知道一篇文章中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………………………………