ML(4): NavieBayes在R中的应用

朴素贝叶斯方法是一种使用先验概率去计算后验概率的方法, 具体见ML(3): 贝叶斯方法

R包

---

① e1071::e1071

② klaR::klaR

参考资料：https://en.wikibooks.org/wiki/Data_Mining_Algorithms_In_R/Classification/Na%C3%AFve_Bayes

算法包：e1071

函数：navieBayes(formule,data,laplace=0,...,subset,na.action=na.pass)

• Formule: 公式的形式：class~x1 + x2 + .....  相互作用是不允许的
• data: 数据集
• lapace: 正面双控制拉普拉期平滑。默认值（0）禁用拉普拉斯平滑。它的思想非常简单，就是对没类别下所有划分的计数为1，这样如果训练样本集数量充分大时，并不会对结果产生影响，并且解决了上述频率为0的局面。【在训练样本中，某一特征的属性值可能没有出现，为了保证一个属性出现次数为0时，能够得到一个很小但是非0的概率值】

R手机短信过滤示例

---

数据下载地址： https://github.com/stedy/Machine-Learning-with-R-datasets/tree/72e6b6cc91bc2bb08eb6f99f52c033677cb70c1a

参考：https://zhuanlan.zhihu.com/p/22615168

原理： http://www.ruanyifeng.com/blog/2011/08/bayesian_inference_part_two.html

代示示例：

• 首先，导入数据(注：第二列文本中带“...”会导制后面的数据读不进来）

  #数据导入
  sms <- read.csv("sms.csv",header=TRUE,stringsAsFactors=FALSE)
  sms$type <- factor(sms$type)
  str(sms)
  table(sms$type)

• 数据清洗: sms$text 文本中包含着数字、缩略的短语和标点符号等，对于NaiveBayesClassifier而言，这些信息是有干扰的，因此，在建模之前需要在语料库中对数据进行清洗。
• 添加tm包 【参见tm包使用： http://www.cnblogs.com/tgzhu/p/6680525.html】，创建语料库，如下：语料库包含5574个document

  #创建语料库
  library(NLP)
  library(tm)
  sms_corpus <- Corpus(VectorSource(sms$text))
  
  #clear corpus
  sms_corpus <- tm_map(sms_corpus, PlainTextDocument)
  # 所有字母转换成小写
  sms_corpus <- tm_map(sms_corpus, tolower)
  # 去除text中的数字
  sms_corpus <- tm_map(sms_corpus, removeNumbers)
  # 去除停用词，例如and,or,until...
  sms_corpus <- tm_map(sms_corpus, removeWords, stopwords())
  # 去除标点符号
  sms_corpus <- tm_map(sms_corpus, removePunctuation)
  # 去除多余的空格，使单词之间只保留一个空格
  sms_corpus <- tm_map(sms_corpus, stripWhitespace)
  #查看一下清理后的语料库文本
  inspect(sms_corpus[1])

• 标记化：将文本分解成由单个单词组成的组，实际就是实现语料库向稀疏矩阵的转变 corpus_clean -> sms_dtm，建立训练集和测试集数据

  #将文本信息转化成DocumentTermMatrix类型的稀疏矩阵
  dtm <- DocumentTermMatrix(sms_corpus)
  Sys.setlocale(category = "LC_ALL", locale = "us")
  
  #训练集和测试集数据,查看垃圾与正常邮件占比
  trainSet <- sms[1:4169,]
  testset <- sms[4170:5574,]

• 创建可视化词云，通过词云可以大致浏览一下哪些词在spam中经常出现，哪些词在ham中经常出现。当然，前者对于垃圾短信的过滤相对重要一点。绘制词云可以通过添加包wordcloud实现  install.packages("wordcloud")
• 为了查看spam和ham各自的多频词，首先取trainset的子集，如下：

  > #创建可视化词云,大致浏览一下哪些词在spam中经常出现
  > library(RColorBrewer)
  > library(wordcloud)
  > #取trainset对spam和ham的子集
  > spam <- subset(trainSet, type == "spam")
  > ham <- subset(trainSet, type == "ham")
  > #创建词云
  > wordcloud(spam$text, max.words=40, scale=c(3,0.5))

• 显示结果如下：
• 
• 缩减特征：在面临问题是稀疏矩阵的特征太多了，而且很多词在所有text中可能都没怎么出现过，为减少运算量对特征瘦瘦身。先留下来在所有text中出现至少5次的词

  dtm_train <- dtm[1:4169,]
  > dtm_test <- dtm[4170:5574,]
  > findFreqTerms(dtm_train,5)
     [1] "available"       "bugis"           "cine"            "crazy"           "got"             "great"           "point"           "wat"
     [9] "world"           "lar"             "wif"             "apply"           "comp"            "cup"             "entry"           "final"
    [17] "free"            "may"             "receive"         "text"            "txt"             "win"             "wkly"            "already"
    [25] "dun"             "early"           "say"             "around"          "goes"            "nah"             "think"           "though"
    [33] "usf"             "back"            "freemsg"         "fun"             "hey"             "like"            "now"             "send"
    [41] "std"             "still"           "weeks"           "word"            "xxx"             "brother"         "even"            "speak"
    [49] "treat"           "callers"         "callertune"      "copy"            "friends"         "melle"           "per"             "press"
  ........................

• 将这些词设置成指示标识，下面建模时用这个指示标识提示模型只对这些词进行计算

  > #缩减特征
  > d <- findFreqTerms(dtm,5)
  > corpus_train = sms_corpus[1:4169]
  > corpus_test = sms_corpus[4170:5574]
  > dtm_train <- DocumentTermMatrix(corpus_train,list(dictionary=d))
  > dtm_test <- DocumentTermMatrix(corpus_test,list(dictionary=d))

• train和test都是计数矩阵，如果一条text中某个单词出现2次，那么这个单词在这条文本下会被记上2，NB只想知道这个单词出现了或者没出现，因此需要对矩阵进行转化成因子矩阵。

  > #对矩阵进行转化成因子矩阵
  > convert_counts <- function(x){
  +   x <- ifelse(x>0,1,0)
  +   x <- factor(x, levels=c(0,1),labels=c("No","Yes"))
  +   return(x)
  + }
  > dtm_train <- apply(dtm_train, MARGIN=2, convert_counts)
  > dtm_test <- apply(dtm_test, MARGIN=2, convert_counts)

• 训练模型

  > #需要的包是e1071
  > #install.packages("e1071")
  > library(e1071)
  > sms_classifier <- naiveBayes(dtm_train,trainSet$type)
  > sms_prediction <- predict(sms_classifier, dtm_test)
  >

• 评估模型: 用交叉表来看看test中多少预测对了

  > library(gmodels)
  > CrossTable(sms_prediction,testset$type,prop.chisq=TRUE,prop.t=FALSE, dnn=c("predicted","actual"))
  
     Cell Contents
  |-------------------------|
  |                       N |
  | Chi-square contribution |
  |           N / Row Total |
  |           N / Col Total |
  |-------------------------|
  
  Total Observations in Table:  1405 
  
               | actual
     predicted |       ham |      spam | Row Total |
  -------------|-----------|-----------|-----------|
           ham |      1124 |       150 |      1274 |
               |     0.229 |     1.531 |           |
               |     0.882 |     0.118 |     0.907 |
               |     0.920 |     0.820 |           |
  -------------|-----------|-----------|-----------|
          spam |        98 |        33 |       131 |
               |     2.229 |    14.886 |           |
               |     0.748 |     0.252 |     0.093 |
               |     0.080 |     0.180 |           |
  -------------|-----------|-----------|-----------|
  Column Total |      1222 |       183 |      1405 |
               |     0.870 |     0.130 |           |
  -------------|-----------|-----------|-----------|

• ham-ham和spam-spam是预测正确的，spam-ham：本身不是垃圾短信却被认为是垃圾短信过滤掉，由于Classifier1没有设置拉普拉斯估计，下面再尝试建立classifier2，看结果是否被优化。

  > #设置拉普拉斯估计
  > sms_classifier <- naiveBayes(dtm_train,trainSet$type,laplace = 1)
  > sms_prediction <- predict(sms_classifier, dtm_test)
  > CrossTable(sms_prediction,testset$type,prop.chisq=TRUE,prop.t=FALSE, dnn=c("predicted","actual"))
  
     Cell Contents
  |-------------------------|
  |                       N |
  | Chi-square contribution |
  |           N / Row Total |
  |           N / Col Total |
  |-------------------------|
  
  Total Observations in Table:  1405 
  
               | actual
     predicted |       ham |      spam | Row Total |
  -------------|-----------|-----------|-----------|
           ham |      1105 |       132 |      1237 |
               |     0.788 |     5.262 |           |
               |     0.893 |     0.107 |     0.880 |
               |     0.904 |     0.721 |           |
  -------------|-----------|-----------|-----------|
          spam |       117 |        51 |       168 |
               |     5.803 |    38.747 |           |
               |     0.696 |     0.304 |     0.120 |
               |     0.096 |     0.279 |           |
  -------------|-----------|-----------|-----------|
  Column Total |      1222 |       183 |      1405 |
               |     0.870 |     0.130 |           |
  -------------|-----------|-----------|-----------|

• spam人预测结果有改进，尝试继续优化，下一步以评论分类进行中文分类模拟

 iris分类预测

---

• 安装加载包

  #安装加载e1071
  #install.packages("e1071")
  library(e1071)

• iris数据集分为训练集和测试集

  index <-sample(1:nrow(iris), 100)
  iris.train <-iris[index, ]
  iris.test <-iris[-index, ]

• 利用朴素贝叶斯算法构建模型

  model.NaiveBayes <-naiveBayes(x =subset(iris.train,select=-Species), y= iris.train$Species)
  str(model.NaiveBayes)
  summary(model.NaiveBayes)

• 用模型对测试集做测试

  > results.NaiveBayes <-predict(object = model.NaiveBayes, newdata =iris.test, type="class")
  > table(results.NaiveBayes, iris.test$Species)
  
  results.NaiveBayes setosa versicolor virginica
          setosa         14          0         0
          versicolor      0         17         2
          virginica       0          1        16