[R - ml] 樸素貝葉斯分類器

之所以叫樸素貝葉斯,
因為獨立的事件,聯(lián)合分布可以拆分為各個分布的乘積。
具體的原理,周末會補充一下。
下面是代碼:

library(e1071)
head(iris)
pairs(iris[1:4], pch = 21, bg = c('red', 'green3', 'blue')[unclass(iris$Species)])
classifier = naiveBayes(iris[, 1:4], iris[, 5])

table(predict(classifier, iris[, -5]), iris[, 5])

垃圾短信分類器

http://www.dt.fee.unicamp.br/~tiago/smsspamcollection/

sms_raw = read.table('E:/rpath/SMSSpamCollection', stringsAsFactors = FALSE, sep = '\t', header = FALSE, comment = '', quote = NULL, encoding = 'UTF-8')
names(sms_raw) = c('type', 'text')

str(sms_raw)

type 轉(zhuǎn)換為factor 變量, 因為貝葉斯分類要求變量為factor類型

sms_raw$type = factor(sms_raw$type)
table(sms_raw$type)

數(shù)據(jù)預處理

對于文本的分析通常我們會用到[tm包]

require(tm)
packageVersion(pkg = 'tm')
sessionInfo() # 看自己的運行環(huán)境,各個包的版本

sms_corpus = Corpus(VectorSource(sms_raw$text))

這里將原始數(shù)據(jù)中的短信都作為向量輸入構(gòu)建語料庫Corpus()

print(sms_corpus)
inspect(sms_corpus[1:3]) # 查看 語料庫里的內(nèi)容

這里可以看到語料庫里有5574個文檔,實際與我們的數(shù)據(jù)集樣本數(shù)一樣,每個文檔對應(yīng)的就是一條短信。
從前3條短信我們看出,文檔里有標題、數(shù)字、還有標點符號,以及大小寫,為了方便分析,我們進行如下處:

corpus_clean <- tm_map(sms_corpus, content_transformer(tolower))
corpus_clean <- tm_map(corpus_clean, tolower)
corpus_clean <- tm_map(corpus_clean, removeNumbers)
corpus_clean <- tm_map(corpus_clean, removeWords, stopwords()) # the, a, 停止詞
corpus_clean <- tm_map(corpus_clean, removePunctuation) # 標點符號
corpus_clean <- tm_map(corpus_clean, stripWhitespace) # 空白
# corpus_clean <- tm_map(corpus_clean, PlainTextDocument)
inspect(corpus_clean[1:3])                                                                                                                      

統(tǒng)計每個詞在文檔中出現(xiàn)的頻率,document term 稀疏矩陣完成,這個稀疏矩陣的行對應(yīng)一個文檔,列對應(yīng)每個詞,term document 則反過來

sms_dtm = DocumentTermMatrix(corpus_clean)
require(caret)
set.seed(2014)
inTrain = createDataPartition(y = sms_raw$type, p = 0.75, list = FALSE)
sms_raw_train = sms_raw[inTrain, ]
sms_raw_test = sms_raw[-inTrain, ]

sms_dtm_train = sms_dtm[inTrain, ]
sms_dtm_test = sms_dtm[-inTrain, ]

sms_corpus_train = corpus_clean[inTrain]
sms_corpus_test = corpus_clean[-inTrain]

prop.table(table(sms_raw_train$type))
prop.table(table(sms_raw_test$type))

最簡單的文本分析方法 就是生成詞云, 我們用wordcloud

require(wordcloud)
wordcloud(sms_corpus_train, min.freq = 40, random.order = FALSE)

這里的 min.freq 是詞出現(xiàn)的最小頻率,通常我們用語料庫的10%來開始(訓練語料庫有4182個文檔)。
上面這個詞云只是給出了一個總體印象,對我們的分析沒有太大幫助,我們考慮分布看看垃圾郵件與正常郵件的區(qū)別

spam = subset(sms_raw_train, type == 'spam')
ham = subset(sms_raw_train, type == 'ham')
wordcloud(spam$text, max.words = 40, scale = c(3, 0.5))
wordcloud(ham$text, max.words = 40, scale = c(3, 0.5))

詞頻

把所有的詞都考慮近來顯然不是很好的方法,我們的矩陣有7938個特征,因此我們需要考慮縮小范圍,
于是采用findFreqTerms的方法取>5的特征(具體取多少根據(jù)數(shù)據(jù)的具體情況):

findFreqTerms(sms_dtm_train, 5)[10:20]
sms_dict = (findFreqTerms(sms_dtm_train, 5))

獲得了詞頻大于5的詞后,我們再利用它來生成一個字典,這樣可以在文檔矩陣中支出,我支取字典中有的詞,新的矩陣只有1252個特征了。

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

我們的目標是想通過短信里面有或者沒有某個詞來判斷是否是垃圾短信,
那么我們顯然應(yīng)該使用的矩陣是標記某個詞在某個短信中出現(xiàn)了還是沒有出現(xiàn),
因此寫個函數(shù)來完成這個功能:

convert_counts = function(x) {
  x = ifelse(x > 0, 1, 0)
  x = factor(x, levels = c(0, 1), labels = c("No", "Yes"))
  return(x)
}

對矩陣每一列進行這樣的處理:

sms_train = apply(sms_train, MARGIN = 2, convert_counts) # margin = 2 是對列變換
sms_test = apply(sms_test, MARGIN = 2, convert_counts)

于是我們可以得到最終用來構(gòu)建模型的數(shù)據(jù)集

模型訓練

在R里面有多個包提供樸素貝葉斯分類,比如e1071包,還有klaR包的 NaiveBayes()。
這里使用e1071

require(e1071)
sms_classifier = naiveBayes(sms_train, sms_raw_train$type)

于是我們得到了分類器sms_classifier

模型評估

有了模型就可以對測試數(shù)據(jù)進行預測:
pred(m, test, type = 'class')
這里的type 如果為class 代表是分類,如果是raw則代表概率的計算

sms_test_pred = predict(sms_classifier, sms_test, type = 'class')
head(sms_test_pred, 5)
require(gmodels)
CrossTable(sms_test_pred, sms_raw_test$type, prop.chisq = FALSE, prop.t = FALSE,
           dnn = c('predicted', 'actual'))

模型改進

拉普拉斯估計問題,用 Laplace = 1

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'))
最后編輯于
?著作權(quán)歸作者所有,轉(zhuǎn)載或內(nèi)容合作請聯(lián)系作者
【社區(qū)內(nèi)容提示】社區(qū)部分內(nèi)容疑似由AI輔助生成,瀏覽時請結(jié)合常識與多方信息審慎甄別。
平臺聲明:文章內(nèi)容(如有圖片或視頻亦包括在內(nèi))由作者上傳并發(fā)布,文章內(nèi)容僅代表作者本人觀點,簡書系信息發(fā)布平臺,僅提供信息存儲服務(wù)。

相關(guān)閱讀更多精彩內(nèi)容

友情鏈接更多精彩內(nèi)容