確率論的学習 - ナイーブベイズを使った分類
Ei Taguchi
Abstract
ナイーブベイズ分類を試すナイーブベイズ分類
ナイーブベイズを用いてスパムメールの判別を行う
データ収集
# データ収集
## 1列目にhamかspamか, 2列目にメール本文
sms_raw <- read.csv("sms_spam.csv", stringsAsFactors = FALSE)
head(sms_raw)## type
## 1 ham
## 2 ham
## 3 ham
## 4 spam
## 5 spam
## 6 ham
## text
## 1 Hope you are having a good week. Just checking in
## 2 K..give back my thanks.
## 3 Am also doing in cbe only. But have to pay.
## 4 complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+
## 5 okmail: Dear Dave this is your final notice to collect your 4* Tenerife Holiday or #5000 CASH award! Call 09061743806 from landline. TCs SAE Box326 CW25WX 150ppm
## 6 Aiya we discuss later lar... Pick u up at 4 is it?前処理
# 前処理
sms_raw$type <- as.factor(sms_raw$type)
table(sms_raw$type)##
## ham spam
## 4812 747## テキストマイニング用パッケージ
library(tm)## Loading required package: NLP##
## Attaching package: 'NLP'## The following object is masked from 'package:ggplot2':
##
## annotate## コーパスの作成
sms_corpus <- VCorpus(VectorSource((sms_raw$text)))
print(sms_corpus)## <<VCorpus>>
## Metadata: corpus specific: 0, document level (indexed): 0
## Content: documents: 5559## コーパスの要約情報
inspect(sms_corpus[1:2])## <<VCorpus>>
## Metadata: corpus specific: 0, document level (indexed): 0
## Content: documents: 2
##
## [[1]]
## <<PlainTextDocument>>
## Metadata: 7
## Content: chars: 49
##
## [[2]]
## <<PlainTextDocument>>
## Metadata: 7
## Content: chars: 23## コーパス内の文書表示
lapply(sms_corpus[1:2], as.character)## $`1`
## [1] "Hope you are having a good week. Just checking in"
##
## $`2`
## [1] "K..give back my thanks."## クリーニング
sms_corpus_clean <- sms_corpus %>%
## 全て小文字にする
tm_map(content_transformer(tolower)) %>%
## 数字を取り除く
tm_map(removeNumbers) %>%
## ストップワードを取り除く(removewordsで取り除き, stopwordsで辞書を指定)
tm_map(removeWords, stopwords()) %>%
## 句読点を取り除く
tm_map(removePunctuation)
##ステミング(原形に戻す)
library(SnowballC)
sms_corpus_clean <- tm_map(sms_corpus_clean, stemDocument)
## 余分なスペースを取り除く
sms_corpus_clean <- tm_map(sms_corpus_clean, stripWhitespace)
## トークン化(行に文書, 列に単語)
### スパースになっている
sms_dtm <- DocumentTermMatrix(sms_corpus_clean)
### 特徴量=terms(単語数)が確認できる
sms_dtm## <<DocumentTermMatrix (documents: 5559, terms: 6542)>>
## Non-/sparse entries: 42112/36324866
## Sparsity : 100%
## Maximal term length: 40
## Weighting : term frequency (tf)## 訓練データとテストデータの割り振り
sms_dtm_train <- sms_dtm[1:4169, ]
sms_dtm_test <- sms_dtm[4170:5559, ]
## ラベル(目的変数)
sms_train_labels <- sms_raw[1:4169, ]$type
sms_test_labels <- sms_raw[4170:5559, ]$type
## ワードクラウド
library(wordcloud)## Loading required package: RColorBrewer### 最低50回, 頻度の高いものを中央に表示
wordcloud(sms_corpus_clean, min.freq = 50, random.order = FALSE)
## spam, hamそれぞれのワードクラウド
### spam
spam <- sms_raw %>%
filter(type == "spam")
#### 最大単語数, 最大単語と最小単語のフォント
wordcloud(spam$text, max.words = 40, scale = c(3, 0.5))## Warning in tm_map.SimpleCorpus(corpus, tm::removePunctuation): transformation
## drops documents## Warning in tm_map.SimpleCorpus(corpus, function(x) tm::removeWords(x,
## tm::stopwords())): transformation drops documents
### ham
ham <- sms_raw %>%
filter(type == "ham")
wordcloud(ham$text, max.words = 40, scale = c(3, 0.5))## Warning in tm_map.SimpleCorpus(corpus, tm::removePunctuation): transformation
## drops documents
## Warning in tm_map.SimpleCorpus(corpus, tm::removePunctuation): transformation
## drops documents
### 出現頻度の高いワードに絞り込む(5回以上出現)
sms_freq_words <- findFreqTerms(sms_dtm_train, 5)
glimpse(sms_freq_words)## chr [1:1137] "£wk" "abiola" "abl" "abt" "accept" "access" "account" ...## 訓練データ, テストデータを頻出ワードだけに絞り込む
sms_dtm_freq_train <- sms_dtm_train[, sms_freq_words]
sms_dtm_freq_test <- sms_dtm_test[, sms_freq_words]
## Yes, Noにおきかえ
convert_counts <- function(x){
x<- ifelse(x>0, "Yes", "No")
}
sms_train <- apply(sms_dtm_freq_train, MARGIN = 2, convert_counts)
sms_test <- apply(sms_dtm_freq_test, MARGIN = 2, convert_counts)モデルを訓練する
# モデルを訓練する
library(e1071)
## 訓練データ, 訓練ラベル, ラプラス推定量(デフォルト0)
sms_classifier <- naiveBayes(sms_train, sms_train_labels, laplace = 0)モデルを評価する
# モデルを評価する
## 訓練済データ, テストデータ
sms_test_pred <- predict(sms_classifier, sms_test)
## 性能評価
library(gmodels)
### dnnで名前を変えられる
CrossTable(sms_test_pred, sms_test_labels,
prop.chisq = F, prop.c = F, prop.r = F,
dnn = c("predict", "actual"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 1390
##
##
## | actual
## predict | ham | spam | Row Total |
## -------------|-----------|-----------|-----------|
## ham | 1201 | 30 | 1231 |
## | 0.864 | 0.022 | |
## -------------|-----------|-----------|-----------|
## spam | 6 | 153 | 159 |
## | 0.004 | 0.110 | |
## -------------|-----------|-----------|-----------|
## Column Total | 1207 | 183 | 1390 |
## -------------|-----------|-----------|-----------|
##
## 正解率 97.4%(1201+153/1390)
適合率 97.6%(1201/1231)
再現率 99.5%(1201/1207)
実際にはspamなのにhamと予測されているものが30件, 実際はhamなのにspamと判断されているものが6件ある. この場合, この6件が迷惑メールフォルダに入ったり, はじかれてしまったりするとまずいので, ここでは再現率を上げたい
モデルの性能をあげる
# モデルの性能を向上させる
## ラプラス推定量を設定してみる(出現確率が0になるのを防ぐ)
## spamにしか出てこない単語があったとしても全てspamに割り振るのはおかしい
sms_classifier2 <- naiveBayes(sms_train, sms_train_labels, laplace = 0.1)
sms_test_pred2 <- predict(sms_classifier2, sms_test)
CrossTable(sms_test_pred2, sms_test_labels,
prop.chisq = F, prop.c = F, prop.r = F,
dnn = c("predict", "actual"))##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 1390
##
##
## | actual
## predict | ham | spam | Row Total |
## -------------|-----------|-----------|-----------|
## ham | 1202 | 26 | 1228 |
## | 0.865 | 0.019 | |
## -------------|-----------|-----------|-----------|
## spam | 5 | 157 | 162 |
## | 0.004 | 0.113 | |
## -------------|-----------|-----------|-----------|
## Column Total | 1207 | 183 | 1390 |
## -------------|-----------|-----------|-----------|
##
## ラプラス推定量を0.1にしてみたら精度があがった. 偽陽性は6から5に偽陰性は30から26になった.