6.3、樸素貝葉斯之垃圾郵件過濾

利用樸素貝葉斯來判斷垃圾短信

這裡我們以判斷垃圾短信為例，資料來自sms spam資料集

1、資料準備----把資料下載下傳後讀入：

>setwd("G:/R/Rworkspace/mail/")

> sms_raw <- read.table("SMSSpamCollection.txt",stringsAsFactors=F, sep="\t", header=F, comment="",quote=NULL, encoding="UTF-8")      注意：在讀取外部資料集時，1369/2730/4421行都含有特殊字元，需要删除後再讀取。

> sms_raw <-read.table("G:/R/Rworkspace/mail/SMSSpamCollection.txt",stringsAsFactors=F, sep="\t", header=F, comment="",quote=NULL,encoding="UTF-8")     此指令等價于上面的兩條指令

> str(sms_raw)

'data.frame':   5574 obs. of 2 variables:

 $ V1: chr  "ham" "ham""spam" "ham" ...

 $ V2: chr  "Go until jurong point, crazy..Available only in bugis n great world la e buffet... Cine there got amorewat..." "Ok lar... Joking wif u oni..." "Free entry in 2 awkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receiveentry question(std txt rate)T&C"| __truncated__ "U dun say soearly hor... U c already then say..." ...

> names(sms_raw) <- c("type", "text")        給資料集命名

> str(sms_raw)

'data.frame':   5574 obs. of 2 variables:

 $ type:chr  "ham" "ham""spam" "ham" ...

 $ text:chr  "Go until jurong point, crazy..Available only in bugis n great world la e buffet... Cine there got amorewat..." "Ok lar... Joking wif u oni..." "Free entry in 2 awkly comp to win FA Cup final tkts 21st May 2005. Text FA to 87121 to receiveentry question(std txt rate)T&C"| __truncated__ "U dun say soearly hor... U c already then say..." ...

注意：如果在read.table裡面不指定quote=NULL那麼會遇到如下問題  Warning message:In scan(file, what, nmax, sep, dec, quote, skip, nlines, na.strings,: EOF within quoted string實際上你如果仔細研究一下資料，你可以發現這是因為資料裡面的5082行開始有""導緻。

接下來将type轉換為factor變量，因為貝葉斯分類要求目标變量為factor類型。

> sms_raw$type<- factor(sms_raw$type)

>table(sms_raw$type)

 ham spam

4827  747

資料集裡面有4827條正常短信，747條垃圾短信

2、資料預處理

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

> library(tm)

> sms_corpus <- Corpus(VectorSource(sms_raw$text))   這裡将原始資料中的短消息都作為向量輸入來建構語料庫

VectorSource（x）：将一個文本向量建立為一個向量源，向量源解釋向量的每一個元素作為一個文檔；x為一個向量的文本；

Corpus（）：語料庫的呈現與計算。語料庫是包含（自然語言）文本的文檔集合。其中采用包TM提供基礎設施軟體包，例如語料庫表示通過虛拟S3類語料庫：這樣的套餐提供S3語料庫類擴充虛拟基類（如vcorpus包裝TM本身提供）。

>print(sms_corpus)

<<VCorpus>>

Metadata:  corpus specific: 0, document level (indexed):0

Content:  documents: 5574

> inspect(sms_corpus[1:3])         擷取前3條短信的詳細資訊

<<VCorpus>>

Metadata:  corpus specific: 0, document level (indexed):0

Content:  documents: 3

[[1]]

<<PlainTextDocument>>

Metadata:  7

Content: chars: 111              注意：這裡隻給出了字元的數量，但原測試顯示了内容。

[[2]]

<<PlainTextDocument>>

Metadata:  7

Content:  chars: 29

[[3]]

<<PlainTextDocument>>

Metadata:  7

Content:  chars: 155

inspect（）函數：顯示語料庫或術國文檔矩陣的詳細資訊

這裡可以看出語料庫有5574個文檔，實際與我們的資料集樣本數一樣。每個文檔對應的就是一條短信。從前3條短信我們看出，文檔的裡面有标題，數字，還有标點符号，以及大小寫，為了友善分析我們進行如下處理：

> 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, PlainTextDocument)

>inspect(corpus_clean[1:3])

<<VCorpus>>

Metadata:  corpus specific: 0, document level (indexed):0

Content:  documents: 3

[[1]]

[1] go jurong pointcrazy available bugis n great world la e buffet cine got amore wat

[[2]]

[1] ok lar jokingwif u oni

[[3]]

[1] free entry wklycomp win fa cup final tkts st may text fa receive entry questionstd txt ratetcsapply s

tm_map():語料庫的轉換；應用轉換函數（映射）到語料庫的接口。

以上依次把所有詞轉換為小寫，去掉數字，去掉停止詞（就是類似and，or，the之類，也就是冠詞、介詞、副詞或連詞），去掉标點，最後去掉所有空格。

3、統計詞頻：完成了上述步驟，我們就需要統計每個詞在文檔中出現的頻率了，這可以通過建構document term稀疏矩陣完成，這個稀疏矩陣的行對應一個文檔，列則對應了每個詞。term document則反過來。

> sms_dtm <- DocumentTermMatrix(corpus_clean)     建構document term稀疏矩陣,稀疏矩陣的行對應一個文檔，列則對應了每個詞

<<DocumentTermMatrix(documents: 5574, terms: 7929)>>

Non-/sparse entries:43087/44153159

Sparsity           : 100%

Maximal term length:40

Weighting          : term frequency (tf)

DocumentTermMatrix()：建構一個術國文檔矩陣或檔案項矩陣

1）、準備訓練與測試資料

有了上面的矩陣，我們就可以開始準備訓練資料與測試資料了，還是用caret包的createDataPartition來完成，可以看出訓練與測試資料中的垃圾短信比例都相似。

> library(caret)

> set.seed(2014)

> inTrain <-createDataPartition(y=sms_raw$type, p=0.75, list=F)

> sms_raw_train<- sms_raw[inTrain, ]

> sms_raw_test <- sms_raw[-inTrain, ]      擷取訓練集和測試集資料

> sms_dtm_train<- sms_dtm[inTrain, ]

> sms_dtm_test <- sms_dtm[-inTrain, ]     從document term稀疏矩陣中擷取訓練集和測試集資料

>sms_corpus_train <- corpus_clean[inTrain]

> sms_corpus_test <- corpus_clean[-inTrain]       從語料庫中擷取訓練集和測試集資料

> table(sms_raw_train$type)        列聯表，列出頻數

 ham spam

3621  561

> prop.table(table(sms_raw_train$type))    列出邊緣表的頻率，參數為列聯表

      ham     spam

0.8658537 0.1341463

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

      ham     spam

0.8663793 0.1336207

createdatapartition(y, times, p=0.5, list)函數：建立一系列的測試/訓練的分區。y為一個輸出的向量，如果是createtimeslices，這些應該是按時間的順序；times為建立的分區的數目；p為訓練資料的百分比；list為F是不将結果列在清單中。

createresample()函數：建立一個或多個Bootstrap樣本；

Createfolds()函數：将資料分為K組；

createtimeslices()函數：建立交叉驗證樣本資訊可用于時間序列資料。

2）、使用wordcloud包分析文本

最簡單的文本分析方法就是市場詞雲了，我們用wordcloud包

>library(wordcloud)

> wordcloud(sms_corpus_train,min.freq=40, random.order=F)     這裡的min.freq是詞出現的最小頻率，通常我們用語料庫的10%來開始(訓練語料庫有4182個文檔)

wordcloud包中的wordcloud(words, min.freq, max.words,random.order, scale=c(4,.5))函數：畫一個字雲。words為文本中的單詞；min.freq表示頻率低于min.freq話不會被繪制；max.words被繪制的最大數目字，最小頻繁項将失效；random.order随機順序畫詞，為F時則按降序順序畫詞;scale 為一個長度為2的向量表示單詞大小的範圍。

上面那個詞雲隻是給出了一個總體印象，對我們的分析沒有太大幫助，所有我們考慮分布看看垃圾郵件與正常郵件的差別

> 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))

很顯然可以看出垃圾郵件裡面free,now,prize,textclaim等比較多

3）、詞頻

把所有的詞都考慮進來顯然不是很好的方法，我們的矩陣有7986個特征，是以我們需要考慮縮小範圍，于是采用findFreqTerms的方法取大于5的特征（具體取多少根據資料的資料情況）：

>findFreqTerms(sms_dtm_train, 5)[10:20]

 [1] "add"       "address"   "admirer"   "advance"   "aft"     

 [6] "afternoon" "age"       "ago"       "ahead"     "aight"   

[11]"aint"   

findFreqTerms(x, lowfreq, highfreq)函數：在文檔術語或術國文檔矩陣中查找頻繁項。x為一個術國文檔矩陣；lowfreq為一個數字，表示較低的頻繁項；highfreq為一個數字，表示較高的頻繁項

> freq5 <-findFreqTerms(sms_dtm_train, 5)

> str(freq5)

 chr [1:1253] "abiola""able" "abt" "accept" "access" ...

> freq5_corpus<- Corpus(VectorSource(freq5))

>freq5_corpus_dtm <- DocumentTermMatrix(freq5_corpus)

> sms_dict <- Terms(freq5_corpus_dtm)

注意：> sms_dict<- Dictionary(findFreqTerms(sms_dtm_train, 5)) 此指令用上面的指令代替，因為tm包中的Dictionary()函數已經删除，用Terms代替。

Terms(x)函數：通路文檔的辨別和條款。x表示術國文檔矩陣。

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

> 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"))

+  return(x)

+ }

對矩陣每一列進行這樣的處理：于是我們可以得到最終用來構模組化型的資料集

> sms_train <-apply(sms_train, MARGIN=2, convert_counts)

>sms_test <- apply(sms_test, MARGIN=2, convert_counts)  

apply(x, MARGIN, FUN)：x表示包含在矩陣中的一個數組；MARGIN表示按列還是按行操作；FUN表示要操作的函數。例如，apply(x, 2, mean) 對資料框x的每列求平均值（2代表按列操作，1代表按行操作）

4）、模型訓練

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

> library(e1071)

> sms_classifier<- naiveBayes(sms_train, sms_raw_train$type)

于是我們得到了分類器sms_classifier

5）、模型評估

有了模型就可以對測試資料進行預測:

predict(object, newdata, type) object：naveBayes模型；newdata：測試資料；type：預測類型，type如果為class代表是分類，如果是raw則代表機率的計算

> sms_test_pred<- predict(sms_classifier, sms_test)

>library(gmodels)

>CrossTable(sms_test_pred, sms_raw_test$type, prop.chisq=F, prop.t=F,dnn=c("predicted", "actual"))

   Cell Contents

|-------------------------|

|                       N |

|           N / Row Total |

|           N / Col Total |

|-------------------------|

Total Observationsin Table:  1392

             | actual

   predicted |       ham |      spam | Row Total |

-------------|-----------|-----------|-----------|

         ham |      1202 |        29|      1231 |

             |     0.976 |    0.024 |     0.884 |

             |     0.997 |    0.156 |           |

-------------|-----------|-----------|-----------|

        spam |         4 |       157 |       161 |

             |     0.025 |    0.975 |     0.116 |

             |     0.003 |    0.844 |           |

-------------|-----------|-----------|-----------|

Column Total |      1206 |       186 |      1392 |

             |     0.866 |    0.134 |           |

-------------|-----------|-----------|-----------|

gmodels包的CrossTable(x, y, prop.chisq, prop.t,dnn)函數：獨立試驗因素的交叉制表。 x為向量或矩陣，如果y指定，必須是一個向量；y為一個矩陣或資料框的向量；prop.chisq為T時，每個單元的卡方貢獻将被包括；prop.t為T時，t分布的分布率将被包括；dnn在結果的尺寸中被給予的名稱。

我們可以看出簡單的貝葉斯模型的效果卻很好，97.6%的正确率，186封垃圾郵件中29封誤判為了正常郵件。而1206封正常郵件中4封誤判為垃圾郵件。把正常郵件誤判為垃圾郵件的影響顯然更大，這是需要考慮的地方。

模型改進

6）、假設拉普拉斯估計：

前面說過了拉普拉斯估計的問題，那麼如果我們假設拉普拉斯估計會怎麼樣呢？

> 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=F, prop.t=F,dnn=c("predicted", "actual"))

   Cell Contents

|-------------------------|

|                       N |

|           N / Row Total |

|           N / Col Total |

|-------------------------|

Total Observationsin Table:  1392

             | actual

   predicted|       ham |      spam | Row Total |

-------------|-----------|-----------|-----------|

         ham |      1204 |        30|      1234 |

             |     0.976 |    0.024 |     0.886 |

             |     0.998 |    0.161 |           |

-------------|-----------|-----------|-----------|

        spam |         2 |       156 |       158 |

             |     0.013 |    0.987 |     0.114 |

             |     0.002 |    0.839 |           |

-------------|-----------|-----------|-----------|

Column Total |      1206 |       186 |      1392 |

             |     0.866 |    0.134 |           |

-------------|-----------|-----------|-----------|

加了拉普拉斯估計後，正常郵件誤判為垃圾郵件從4封減少了2封，而垃圾郵件誤判為正常郵件從29封的增加了1封。似乎新的模型要好些。

來自 <http://zjdian.com/2014/08/22/2014-8-22-naive-bayes/>