#---------------------------------------- # 功能描述:演示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‘))
时间: 2024-10-06 00:04:29