机器学习与R语言：NB

#----------------------------------------
# 功能描述：演示NB建模过程
# 数据集：SMS文本信息
# tm包：维也纳财经大学提供
#----------------------------------------

#第一步：收集数据
# import the CSV file
sms_raw <- read.csv("/Users/chenyangang/R语言/data/sms_spam.csv", stringsAsFactors = FALSE)

#第二步：探索和准备数据
# 分类变量因子化 spam/ham 
sms_raw$type <- factor(sms_raw$type)

# 加载文本挖掘包
library(tm)

#创建语料库
sms_corpus <- Corpus(VectorSource(sms_raw$text))

#查看数据
print(sms_corpus)
inspect(sms_corpus[1:3])

#新增停用词
stopwordVector <- c("supplier","order")

# clean up the corpus using tm_map()
corpus_clean <- tm_map(sms_corpus, tolower)
corpus_clean <- tm_map(corpus_clean, removeNumbers)
corpus_clean <- tm_map(corpus_clean, removeWords, stopwords())
corpus_clean <- tm_map(corpus_clean, removePunctuation)
corpus_clean <- tm_map(corpus_clean, stripWhitespace)

#去掉新增停用词
corpus_clean <- tm_map(corpus_clean, removeWords, stopwordVector)

#PlainTextDocument 对象，最后处理
corpus_plain <- tm_map(corpus_clean, PlainTextDocument)

# 创建稀疏矩阵
sms_dtm <- DocumentTermMatrix(corpus_plain,control = list())


# 创建测试数据集和训练数据集
sms_raw_train <- sms_raw[1:4169, ]
sms_raw_test  <- sms_raw[4170:5559, ]

#然后是文本－单词矩阵
sms_dtm_train <- sms_dtm[1:4169, ]
sms_dtm_test  <- sms_dtm[4170:5559, ]

#最后得到语料库
sms_corpus_train <- corpus_plain[1:4169]
sms_corpus_test  <- corpus_plain[4170:5559]

# 查看训练数据集和测试数据集中的占比
prop.table(table(sms_raw_train$type))
prop.table(table(sms_raw_test$type))


#加载词云包
library(wordcloud)

#这里最好用有区分的颜色，RColorBrewer中的Dark2和Set1推荐使用 
pal2 <- brewer.pal(8,"Dark2") 
wordcloud(corpus_plain, scale=c(3, 0.5),min.freq=10, min.words = 10, random.order=FALSE, rot.per=.15, colors=pal2)
wordcloud(sms_corpus_train, min.freq = 40, random.order = FALSE, rot.per=.15, colors=pal2)

# 训练数据区分垃圾邮件和非垃圾邮件
spam <- subset(sms_raw_train, type == "spam")
ham  <- subset(sms_raw_train, type == "ham")

#分别查看垃圾邮件和非垃圾邮件词云图，如果需要保存图片采用png方法
#--png(file = "/Users/chenyangang/01.png", bg = "transparent")
#--dev.off()

wordcloud(spam$text, max.words = 40, scale = c(3, 0.5), random.order = FALSE, rot.per=.15, colors=pal2)
wordcloud(ham$text, max.words = 40, scale = c(3, 0.5), random.order = FALSE, rot.per=.15, colors=pal2)

# 标示大于5次的关键词(为频繁出现的单词创建指示特征)
sms_term <- TermDocumentMatrix(sms_corpus,control = list(removePunctuation = TRUE,stopwords = TRUE))

#获取次数大于5次的词组成字典（未调通代码）
#sms_dict <- Dictionary(findFreqTerms(sms_dtm_train, 5))
#sms_list <- Terms(findFreqTerms(sms_term, 5))
sms_dict <- findFreqTerms(sms_term, 5)

sms_train <- DocumentTermMatrix(sms_corpus_train, list(dictionary = sms_dict))
sms_test  <- DocumentTermMatrix(sms_corpus_test, list(dictionary = sms_dict))

# 转换为因子变量
convert_counts <- function(x) {
  x <- ifelse(x > 0, 1, 0)
  x <- factor(x, levels = c(0, 1), labels = c("No", "Yes"))
}

# 将训练数据和测试数据按列转换为因子变量
sms_train <- apply(sms_train, MARGIN = 2, convert_counts)
sms_test  <- apply(sms_test, MARGIN = 2, convert_counts)

## 第三步: 训练模型
#----------------------------------------------
#创建分类器：
#         m <- naiveBayes(train, class, laplace = 0)
#   train: 数据框或包含训练数据的矩阵
#   class: 包含训练数据的每一行的分类的一个因子向量
#   laplace: 控制拉普拉斯估计的一个数值（默认为0）
#   该函数返回一个朴素贝叶斯对象，该对象能够用于预测
#
#   进行预测：
#         p <- predict(m, test, type = "class")
#       m: 由naiveBayes(train, class, laplace = 0) 训练的模型对象
#       test:数据框或包含测试数据的矩阵，包含用来建立分类器的训练数据相同的特征
#       type：值为“class”或“raw”,标示预测是最可能的类别值或者原始的预测概率
#   该函数返回一个向量，根据参数type的值，该向量含有预测的类别值或者原始的预测概率
#   example:
#           sms_classifier <- naiveBayes(sms_train, sms_raw_train$type)
#           sms_test_pred <- predict(sms_classifier, sms_test)
#----------------------------------------------
library(e1071)
sms_classifier <- naiveBayes(sms_train, sms_raw_train$type)
sms_classifier

## 第四步: 评估模型性能
sms_test_pred <- predict(sms_classifier, sms_test)

library(gmodels)
CrossTable(sms_test_pred, sms_raw_test$type,
           prop.chisq = TRUE, prop.t = TRUE, prop.r = TRUE,
           dnn = c(\'predicted\', \'actual\'))

## 第五步: 提升模型性能(应用拉普拉斯估计：本质是给频率数的每个计数加上一个较小的数)
sms_classifier2 <- naiveBayes(sms_train, sms_raw_train$type, laplace = 1)
sms_test_pred2 <- predict(sms_classifier2, sms_test)
CrossTable(sms_test_pred2, sms_raw_test$type,
           prop.chisq = FALSE, prop.t = FALSE, prop.r = FALSE,
           dnn = c(\'predicted\', \'actual\'))