機器學習與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'))