• 设为首页
  • 点击收藏
  • 手机版
    手机扫一扫访问
    迪恩网络手机版
  • 关注官方公众号
    微信扫一扫关注
    公众号

机器学习与R语言:NB

原作者: [db:作者] 来自: [db:来源] 收藏 邀请
#----------------------------------------
# 功能描述:演示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\'))

  


鲜花

握手

雷人

路过

鸡蛋
该文章已有0人参与评论

请发表评论

全部评论

专题导读
上一篇:
R语言中机器学习的包发布时间:2022-07-18
下一篇:
『原创』机器学习算法的R语言实现(二):决策树算法 - Digging4 ...发布时间:2022-07-18
热门推荐
热门话题
阅读排行榜

扫描微信二维码

查看手机版网站

随时了解更新最新资讯

139-2527-9053

在线客服(服务时间 9:00~18:00)

在线QQ客服
地址:深圳市南山区西丽大学城创智工业园
电邮:jeky_zhao#qq.com
移动电话:139-2527-9053

Powered by 互联科技 X3.4© 2001-2213 极客世界.|Sitemap