確率とは何か 【P81】

本項における確率とは観測された事象の頻度に基づく確率のことです。事象\(A\)が発生する確率は\(P(A)\)と表すことができます。逆に事象\(A\)が発生しない確率は\(P(\lnot A)\)と表します。\(\lnot\)は「否定」を意味する論理記号です。

同時確率とは何か 【P82】

事象\(A\)と事象\(B\)の発生に関係性がなくお互いに独立である（独立事象である）場合、事象\(A\)と事象\(B\)が起こる確率を同時確率と呼び

\[P(A \cap B)\]

と表現します。このような事象の独立性は、事象\(A\)が発生しようとしまいと事象\(B\)の発生にはなんの影響もない、つまり、事象\(A\)の発生は事象\(B\)の確率に何の影響も与えないない（逆もしかり）ということを意味しています。例えば、コインとサイコロを同時に投げる場合は独立事象に相当します。

\[P(A \cap B) = P(A \land B) = P(A) \times P(B)\]

一方、事象\(A\)と事象\(B\)の発生に何等かの関係がある場合、例えば、福引の回転式抽選器のように一回目の出玉で二回目の出玉の確率が変わるような場合を従属事象（または排反事象）、起こる確率を条件付き確率と呼び、以下で表現します。

\[P(A \mid B)\]

この条件付き確率を上手く説明しているのが、ナイーブベイズの基礎となっているベイズの定理です。

ガチャ確率計算機の作者が語る！「これが、ガチャの落とし穴だ！」

ベイズの定理による条件付き確率の計算 【P84】

ベイズの定理は以下で表現されます。

\[P(A \mid B) = \frac{P(A \cap B)}{P(B)}\]

左辺の\(P(A \mid B)\)は前述のように条件付き確率と呼ばれ事象\(B\)が起こった場合に事象\(A\)が起こる確率です。スパムフィルタで考えると

　事象\(B\) : あるキーワードを含むSMSを受信する確率
　事象\(A\) : それがスパムである確率

といえます。右辺は【P83 図4-3】のベン図の説明の通りで\(P(A \cap B)\)は同時確率と呼ばれ事象\(A\)と事象\(B\)が同時に起こる確率、\(P(B)\)は事象\(B\)が起こる確率です。つまり、スパムフィルタで考えると「あるキーワードを含むSMSを受信」しない限り「それがスパム」にはなりえないので、事象\(A\)と事象\(B\)はそれぞれ独立に起こる独立事象ではなく、事象\(B\)が起きた時に事象\(A\)が発生する従属事象といえます。

この式を変形させると

\[P(A \cap B) = P(A \mid B) \times P(B)\]

となり\(P(A \cap B)\)は

\[P(A \cap B) = P(B \cap A)\]

と入れ替えても等価なので、\(P(A \mid B)\)を以下のように変形することができます。

\[P(A \mid B) = \frac{P(A \cap B)}{P(B)} = \frac{P(B \cap A)}{P(B)}\] \[ = \frac{P(B \mid A)P(A)}{P(B)} \propto P(B \mid A)P(A)\]

事象\(A\)が発生する確率から見ると事象\(B\)が発生する確率は定数と見なせるので、省略して上記右辺のような形に変形できます。

単純ベイズを使った分類 【P87】

実際のメッセージ\(Msg\)は複数の単語\(W_i, i=1,...,n\)から構成されていますので語順を考慮しなければ（単語間の独立性を仮定すれば）前述のように論理積（\(\land\)）を使って

\[P(spam \mid Msg) \propto P(W_1 \land ... \land W_n \mid spam)P(spam)\] \[ = P(spam) \prod_{i = 1}^{n}{P(W_i \mid spam)}\]

と表現できます。スパムのみならず文書は単語の出現にはなんらかの関係性があると考えるのが普通ですが、この関係性を無視して独立性を仮定して確率の積として単純化するのでナイーブベイズがナイーブ（単純）と言われる由縁です。

上記の式を一般化すると\(F_i, i = 1, ..., n\) のフィーチャー（スパムフィルタでは単語）がある場合、クラス\(C\)（目的変数）において\(C_L\)（スパムフィルタではスパムまたはハム）が発生する確率は\(F_1,...,F_n\)（説明変数）に依存する係数（定数）\(Z\)を用いて以下のように定義できます。

\[P(C_L \mid F_1, ..., F_n) = \frac{1}{Z}P(C_L)\prod_{i = 1}^{n}{P(F_i \mid C_L)}\]

これがナイーブベイズの計算式です。最も確率の高いクラスが該当するクラスと推定できます。

\[\hat{C_L} = \mathop{\arg \max} \limits_{C_L} P(C_L) \ \prod_{i=1}^n P(F_i \mid C_L)\]

ラプラス推定量 【P89】

テスト時にトレーニングデータに含まれていないフィーチャー（スパムフィルタでは単語）が出てきた場合、事前確率が\(P(C_L) = 0\)となるため、事後確率も\(P(C_L \mid F_1, ..., F_n) = 0\)となってしまいます。このような問題はゼロ頻度問題と呼ばれ、解決するため（確率を\(0\%\)にしないため）にフィーチャーの出現回数に小さな値（通常は0にならないように\(1\)）を加える処理を行います。この処理をラプラススムージングと呼び、加える値をラプラス推定量と言います。

アンダーフロー対策【テキスト外】

実例を見るとわかりますがSMSメッセージには様々な単語が含まれていますので、単語数はかなりの数になります。\(\prod P(F_i \mid C_L)\)の計算において\(1\)以下の値の掛け算が多数回行われアンダーフローが起きる可能性があります。アンダーフローが起こると事後確率\(P(C_L \mid F_1,...,Fn)\)が常に\(0\%\)となってしまいますので、対数変換を行い乗算（\(\prod\)）を加算（\(\sum\)）に変えることでアンダーフローの発生を抑止します。なお、\(log(0)\)は計算できませんので、前述のラプラススムージングとの併用が必須となります。 　
　

単純ベイズにおける数値フィーチャー 【P90】

テキストでは数値フィーチャー（連続値）を扱うにはカテゴリカルデータ化する必要があると記載されています。また、本ページの頭に掲載している“scikit-learn algorithm cheat-sheet”でもナイーブベイズ分類器は「テキストデータ」の分類用とされています。
　
しかし、Rに実装されているナイーブベイズ分類器は連続値（数値）を直接引数に取ることができます。テキストで利用しているe1071::naiveBayes関数に限らずklaRパッケージのklaR::NaiveBayes関数も連続値を扱えます。連続値の場合は、事前分布を元に事後分布を計算するので基本的な考え方は変わりません。詳しくは このあたり や このあたり 具体的な事例は このあたり を参考にしてみてください。

注意【テキスト外】

データファイルの一部にエンコードミスがあり Second Edtionにて修正 されたファイルが公開されていますが、1072行目の文末に「“」という文字が単独で存在しているために1073行目が正しく処理されません。本ページでは修正ファイルに更に修正を加えたファイルを使用していますのでテキストとは若干異なった処理結果になっています。また、Windows環境ではエンコードを指定しないで読み込むとエンコーディング処理の不具合でコーパス処理の際にエラーが出ますので、必ずエンコーディングを指定してください。

エンコード指定方法

sms_raw <- read.csv("sms_spam.csv", stringsAsFactors = FALSE,
                    encoding = "UTF-8")

構造の確認 【P94】

str関数は名前の通り構造（structure）を表示する関数です。

str(sms_raw)

## 'data.frame':    5559 obs. of  2 variables:
##  $ type: chr  "ham" "ham" "ham" "spam" ...
##  $ text: chr  "Hope you are having a good week. Just checking in" "K..give back my thanks." "Am also doing in cbe only. But have to pay." "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline"| __truncated__ ...

skimr::skim_to_wide(sms_raw)

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

## 'data.frame':    5559 obs. of  2 variables:
##  $ type: Factor w/ 2 levels "ham","spam": 1 1 1 2 2 1 1 1 2 1 ...
##  $ text: chr  "Hope you are having a good week. Just checking in" "K..give back my thanks." "Am also doing in cbe only. But have to pay." "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline"| __truncated__ ...

table(sms_raw$type)

## 
##  ham spam 
## 4812  747

データの準備 - テキストデータのクリーニングと標準化 【P94】

クレンジング処理はtmパッケージを利用しますので、最初にtmパッケージを読み込んでおきます。

library(tm)

sms_corpus <- tm::VCorpus(tm::VectorSource(sms_raw$text))
sms_corpus

## <<VCorpus>>
## Metadata:  corpus specific: 0, document level (indexed): 0
## Content:  documents: 5559

class(sms_corpus)

## [1] "VCorpus" "Corpus"

str(sms_corpus[1])

## List of 1
##  $ 1:List of 2
##   ..$ content: chr "Hope you are having a good week. Just checking in"
##   ..$ meta   :List of 7
##   .. ..$ author       : chr(0) 
##   .. ..$ datetimestamp: POSIXlt[1:1], format: "2019-08-24 06:52:42"
##   .. ..$ description  : chr(0) 
##   .. ..$ heading      : chr(0) 
##   .. ..$ id           : chr "1"
##   .. ..$ language     : chr "en"
##   .. ..$ origin       : chr(0) 
##   .. ..- attr(*, "class")= chr "TextDocumentMeta"
##   ..- attr(*, "class")= chr [1:2] "PlainTextDocument" "TextDocument"
##  - attr(*, "class")= chr [1:2] "VCorpus" "Corpus"

tm::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

as.character(sms_corpus[[1]])

## [1] "Hope you are having a good week. Just checking in"

as.character(sms_corpus[[4]])

## [1] "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+"

sms_corpus[[1]]$content

## [1] "Hope you are having a good week. Just checking in"

sms_corpus[[1]]$meta$datetimestamp

## [1] "2019-08-24 06:52:42 GMT"

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 <- tm::tm_map(sms_corpus, tm::content_transformer(tolower))

as.character(sms_corpus[[4]])

## [1] "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+"

as.character(sms_corpus_clean[[4]])

## [1] "complimentary 4 star ibiza holiday or £10,000 cash needs your urgent collection. 09066364349 now from landline not to lose out! box434sk38wp150ppm18+"

sms_corpus_clean <- tm::tm_map(sms_corpus_clean, tm::removeNumbers)

as.character(sms_corpus[[4]])

## [1] "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+"

as.character(sms_corpus_clean[[4]])

## [1] "complimentary  star ibiza holiday or £, cash needs your urgent collection.  now from landline not to lose out! boxskwpppm+"

sms_corpus_clean <- tm::tm_map(sms_corpus_clean, tm::removeWords,
                               tm::stopwords())

as.character(sms_corpus[[4]])

## [1] "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+"

as.character(sms_corpus_clean[[4]])

## [1] "complimentary  star ibiza holiday  £, cash needs  urgent collection.  now  landline   lose ! boxskwpppm+"

sms_corpus_clean <- tm::tm_map(sms_corpus_clean, tm::removePunctuation)

as.character(sms_corpus[[4]])

## [1] "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+"

as.character(sms_corpus_clean[[4]])

## [1] "complimentary  star ibiza holiday  £ cash needs  urgent collection  now  landline   lose  boxskwpppm"

library(SnowballC)
sms_corpus_clean <- tm::tm_map(sms_corpus_clean, tm::stemDocument)

as.character(sms_corpus[[4]])

## [1] "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+"

as.character(sms_corpus_clean[[4]])

## [1] "complimentari star ibiza holiday £ cash need urgent collect now landlin lose boxskwpppm"

sms_corpus_clean <- tm::tm_map(sms_corpus_clean, tm::stripWhitespace)

as.character(sms_corpus[[4]])

## [1] "complimentary 4 STAR Ibiza Holiday or £10,000 cash needs your URGENT collection. 09066364349 NOW from Landline not to lose out! Box434SK38WP150PPM18+"

as.character(sms_corpus_clean[[4]])

## [1] "complimentari star ibiza holiday £ cash need urgent collect now landlin lose boxskwpppm"

データの準備 - 文書の単語への分割 【P100-101】

クレンジング処理ができましたのでトークン化処理（単語単位への分割）を行います。処理結果はDTM(Document-Term Matrix)と呼ばれる行列形式になります。

sms_dtm <- tm::DocumentTermMatrix(sms_corpus_clean)
sms_dtm

## <<DocumentTermMatrix (documents: 5559, terms: 6542)>>
## Non-/sparse entries: 42112/36324866
## Sparsity           : 100%
## Maximal term length: 40
## Weighting          : term frequency (tf)

テキストとは若干値が異なりますが、データ自体やパッケージのバージョンが異なるなどの差異がありますので、あまり気にしないでください。

結果の読み方は、「\(5,559\)」のドキュメント（インスタンス）と「\(6,542\)」の単語（フィーチャー）からなり、最も長い単語が\(40\)文字で、セルの値（度数, term frequency）がゼロでない（Non-sparse）セルが「\(42,112\)」個、残る「\(36,324,866\)」個のセルの値はゼロです。このような行列は疎行列（Sparse Matrix）と呼ばれます。「Sparsity（希薄性）」は、\(99.8842026\%\)で、小数点以下を表示しないために\(100\%\)と表示されています。

この疎行列がナイーブベイズの処理に必要な頻度表を作成するためのベースとなります。
　
参考までに長いタームのトップ10は以下のようなものです。

data.frame(term = sms_dtm$dimnames$Terms, stringsAsFactors = FALSE) %>% 
  dplyr::rowwise() %>% 
  dplyr::mutate(length = nchar(term)) %>% 
  dplyr::arrange(desc(length)) %>% 
  head(10)

DTMの実態 【テキスト外】

Document-Term Matrixオブジェクト（sms_dtm）の実態は以下のようなドキュメント（番号）と単語（Term）のマトリクス型データ（頻度表）です。tm::inspect関数を用いると確認することができます。

tm::inspect(sms_dtm)

## <<DocumentTermMatrix (documents: 5559, terms: 6542)>>
## Non-/sparse entries: 42112/36324866
## Sparsity           : 100%
## Maximal term length: 40
## Weighting          : term frequency (tf)
## Sample             :
##       Terms
## Docs   call can come day free get just know now will
##   1814    1   0    0   0    0   0    0    0   0    0
##   2046    0   0    0   0    0   0    0    1   0    0
##   295     0   0    0   0    1   0    0    0   0    0
##   2993    0   1    0   1    0   0    0    0   0    0
##   313     0   0    1   2    0   1    0    0   0   11
##   3201    0   0    0   0    1   0    0    0   0    0
##   3522    0   0    0   0    0   0    0    0   0    0
##   399     0   0    0   0    0   0    0    0   0    0
##   5068    0   0    0   6    0   0    0    0   0    0
##   5279    0   3    0   0    1   1    0    0   0    0

　
例えば、クレンジング後の313番目の文書には“will”という単語が11回出てきていることがわかります。クレンジング前の313番目の文書と比べてみましょう。

sms_raw[313, ]$text %>% knitr::kable()

For me the love should start with attraction.i should feel that I need her every time around me.she should be the first thing which comes in my thoughts.I would start the day and end it with her.she should be there every time I dream.love will be then when my every breath has her name.my life should happen around her.my life will be named to her.I would cry for her.will give all my happiness and take all her sorrows.I will be ready to fight with anyone for her.I will be in love when I will be doing the craziest things for her.love will be when I don’t have to proove anyone that my girl is the most beautiful lady on the whole planet.I will always be singing praises for her.love will be when I start up making chicken curry and end up makiing sambar.life will be the most beautiful then.will get every morning and thank god for the day because she is with me.I would like to say a lot..will tell later..

閑話休題。このDTMをスパムと非スパム（ハム）にまとめたものが【P85】にある頻度表です。そこから【表4-3】にあるような尤度表を作成することが可能になります。

　
ちなみに、DTMを転置させたTermDocumentMatrix(TDM)も作成可能です。

sms_corpus_clean %>% 
  tm::TermDocumentMatrix() %>% 
  tm::inspect()

## <<TermDocumentMatrix (terms: 6542, documents: 5559)>>
## Non-/sparse entries: 42112/36324866
## Sparsity           : 100%
## Maximal term length: 40
## Weighting          : term frequency (tf)
## Sample             :
##       Docs
## Terms  1814 2046 295 2993 313 3201 3522 399 5068 5279
##   call    1    0   0    0   0    0    0   0    0    0
##   can     0    0   0    1   0    0    0   0    0    3
##   come    0    0   0    0   1    0    0   0    0    0
##   day     0    0   0    1   2    0    0   0    6    0
##   free    0    0   1    0   0    1    0   0    0    1
##   get     0    0   0    0   1    0    0   0    0    1
##   just    0    0   0    0   0    0    0   0    0    0
##   know    0    1   0    0   0    0    0   0    0    0
##   now     0    0   0    0   0    0    0   0    0    0
##   will    0    0   0    0  11    0    0   0    0    0

処理ステップについて 【テキスト外】

tm::tm_map関数による処理はtmパッケージを用いて作成したVCorpusオブジェクトにしか適用できないため汎用性はありません（汎化性能が低い）。また、VCorpusオブジェクトはリスト型であるため処理にも相応の時間を必要とします。加えて、テキストの処理ではVCorpusオブジェクトの属性情報は一切利用していません。そうなるとVCorpusオブジェクトで処理する意味はどこにあるのでしょうか？
　
日本語を処理することを考えるとデータフレームの状態で処理できるtidyverseパッケージによるクレンジング処理の方が汎用性・応用性が高いと考えます。tidyverseパッケージを用いてクレンジング処理をするメリットは

• 処理結果が分かりやすい
  • データフレームは表形式で表示できるのでデータを俯瞰しやすい
  • 表示に便利なパッケージがそろっている（DTパッケージなど）
• 処理が汎用的である（汎化性能が高い）
  • 日本語特有の変換処理も簡単に対応できる
• ベクトル処理なので処理が高速
  • 単純に比較してみたら約10倍の差

などがあげられます。基本的な手順はテキストと同じですが、コーパス化する前にクレンジング処理を行う点が異なります。参考までにデータフレームでクレンジング処理を行う際の手順を記載しておきます。ご興味のある方はご自身で試してみてください。

更にtidytextパッケージを用いるとコーパス化することなくデータフレームのみで処理を完結させることが可能になります。

処理ステップによる差について 【P102】

テキストでは二つの処理ステップによる差について記載しておりテキストクレンジングの原則には「操作の順序が意味をもつ」としています。しかし、単に順序が意味をもつのではなく分析の目的に見合ったデータをどのように絞り込むか（目的はなにか）がポイントであり、そのために提供されている手段（関数）がどのようになっているかを理解しておくことがポイントだと考えます。
　
今回の処理順には以下の背景があります。

• 最初に小文字化するのはストップワードの定義が小文字であるため
• 記号を削除する前にストップワードを削除するのはストップワードに記号が含まれるため
• 数字はスパムであろとうなかろうと含まれているのでスパムの特徴にはならない（なりにくい）ため
  • 特定の電話番号や金額などはスパムの特徴になる可能性はある
• ステミングはトークンを抽象化するため

このように対象データを観察して特徴を把握しておくことが重要です。

データの準備 - 訓練、テストデータセットの作成 【P103】

DTMが作成できましたので、DTMの内\(75\%(4169)\)をトレーニング用、残りの\(25\%(1390)\)をテスト用データとして分割します。対象データがマトリクス型なので素直にテキスト通りの処理を行います。

sms_dtm_train <- sms_dtm[1:4169, ]
sms_dtm_test <- sms_dtm[4170:5559, ]

DTMにはラベル要素が含まれていませんので、大元のデータフレームからラベルを作成しておきます。

sms_train_labels <- sms_raw[1:4169, ]$type
sms_test_labels <- sms_raw[4170:5559, ]$type

念の為にトレーニング用、テスト用の各データに含まれるスパムの比率を確認しておきます。

sms_train_labels %>% 
  table() %>% prop.table()

## .
##       ham      spam 
## 0.8647158 0.1352842

sms_test_labels %>% 
  table() %>% prop.table()

## .
##       ham      spam 
## 0.8683453 0.1316547

トレーニング用データもテスト用データもほぼ同じ比率でスパムが含まれていることがわかります。

テキストデータの可視化 - ワードクラウド 【P103−104】

ワードクラウドはおまけで、ナイーブベイズの処理には必要ありません。SMSのメッセージにはどのようなトークン（単語）が多く含まれているのかを確認するために可視化してみます。このような可視化にはワードクラウドと呼ばれる可視化手法が向いています。

wordcloud::wordcloud(sms_corpus_clean,min.freq = 50, random.order = FALSE)

SMSメッセージ全体の傾向がわかりましたので、スパムと非スパムでの傾向の違いが分かるように可視化してみます。

sms_raw %>% 
  dplyr::filter(type == "spam") %>% 
  with(wordcloud::wordcloud(text, max.words = 40, scale = c(3, 0.5),
                            random.order = TRUE))

sms_raw %>% 
  dplyr::filter(type == "ham") %>% 
  with(wordcloud::wordcloud(text, max.words = 40, scale = c(3, 0.5),
                            random.order = TRUE))

データの準備 - 頻出語のためのインジケータフィーチャーの作成 【P107】

最後にナイーブベイズ分類器を訓練するためのデータを作成します。出現頻度が低いトークン（単語）は訓練に用いてもあまり効果がないと考えられますので、トレーニング用のDTMにおいて出現頻度が5未満の単語を削除して頻出語リスト（ベクトルデータ）を作成します。tm::findFreqTerms関数は与えられたDTMから最低頻度（lowfreq）以上、最高頻度（highfreq）以下の出現頻度の単語を抜き出します。

sms_freq_words <- sms_dtm_train %>% 
  tm::findFreqTerms(lowfreq = 5, highfreq = Inf)
str(sms_freq_words)

##  chr [1:1137] "£wk" "abiola" "abl" "abt" "accept" "access" "account" ...

　
実行結果は省略しますがsms_freq_wordsはベクトル型のデータで1137個のトークン（単語）が含まれています。この結果を用いてトレーニング用、テスト用DTMから頻出語が含まれているデータのみを抜き出します。

(sms_dtm_freq_train <- sms_dtm_train[ , sms_freq_words]) %>% 
  tm::inspect()

## <<DocumentTermMatrix (documents: 4169, terms: 1137)>>
## Non-/sparse entries: 24942/4715211
## Sparsity           : 99%
## Maximal term length: 19
## Weighting          : term frequency (tf)
## Sample             :
##       Terms
## Docs   call can come free get just know like now will
##   1814    1   0    0    0   0    0    0    0   0    0
##   2046    0   0    0    0   0    0    1    1   0    0
##   295     0   0    0    1   0    0    0    1   0    0
##   2993    0   1    0    0   0    0    0    0   0    0
##   313     0   0    1    0   1    0    0    1   0   11
##   3201    0   0    0    1   0    0    0    1   0    0
##   3507    1   0    0    0   0    2    0    0   0    1
##   3522    0   0    0    0   0    0    0    0   0    0
##   399     0   0    0    0   0    0    0    0   0    0
##   808     0   0    0    0   0    0    1    0   0    0

(sms_dtm_freq_test <- sms_dtm_test[ , sms_freq_words]) %>% 
  tm::inspect()

## <<DocumentTermMatrix (documents: 1390, terms: 1137)>>
## Non-/sparse entries: 7981/1572449
## Sparsity           : 99%
## Maximal term length: 19
## Weighting          : term frequency (tf)
## Sample             :
##       Terms
## Docs   call can come day get just know love now will
##   4243    1   0    0   1   0    0    1    0   0    0
##   4413    1   0    0   0   0    0    0    0   0    0
##   4493    0   1    1   0   0    0    1    0   0    0
##   4515    0   1    0   0   3    0    0    0   0    0
##   4649    1   0    0   0   0    0    0    0   0    0
##   4830    0   2    0   0   1    0    0    0   0    1
##   5068    0   0    0   6   0    0    0    0   0    0
##   5279    0   3    0   0   1    0    0    0   0    0
##   5359    1   2    1   0   1    1    0    0   1    0
##   5488    1   1    0   0   0    1    1    0   0    0

次にトレーニング、テスト用データを二値化します。

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)

tm::inspect(sms_dtm_freq_train)

## <<DocumentTermMatrix (documents: 4169, terms: 1137)>>
## Non-/sparse entries: 24942/4715211
## Sparsity           : 99%
## Maximal term length: 19
## Weighting          : term frequency (tf)
## Sample             :
##       Terms
## Docs   call can come free get just know like now will
##   1814    1   0    0    0   0    0    0    0   0    0
##   2046    0   0    0    0   0    0    1    1   0    0
##   295     0   0    0    1   0    0    0    1   0    0
##   2993    0   1    0    0   0    0    0    0   0    0
##   313     0   0    1    0   1    0    0    1   0   11
##   3201    0   0    0    1   0    0    0    1   0    0
##   3507    1   0    0    0   0    2    0    0   0    1
##   3522    0   0    0    0   0    0    0    0   0    0
##   399     0   0    0    0   0    0    0    0   0    0
##   808     0   0    0    0   0    0    1    0   0    0

sms_train[c("1814", "2046", "295", "2993", "313", "3201", "3507", "3522",
            "399", "808"),
          c("call", "can", "come", "day", "free", "get", "just", "like",
            "now", "will")]

##       Terms
## Docs   call  can   come  day   free  get   just  like  now  will 
##   1814 "Yes" "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No" 
##   2046 "No"  "No"  "No"  "No"  "No"  "No"  "No"  "Yes" "No" "No" 
##   295  "No"  "No"  "No"  "No"  "Yes" "No"  "No"  "Yes" "No" "No" 
##   2993 "No"  "Yes" "No"  "Yes" "No"  "No"  "No"  "No"  "No" "No" 
##   313  "No"  "No"  "Yes" "Yes" "No"  "Yes" "No"  "Yes" "No" "Yes"
##   3201 "No"  "No"  "No"  "No"  "Yes" "No"  "No"  "Yes" "No" "No" 
##   3507 "Yes" "No"  "No"  "No"  "No"  "No"  "Yes" "No"  "No" "Yes"
##   3522 "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No" 
##   399  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No" 
##   808  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No"

tm::inspect(sms_dtm_freq_test)

## <<DocumentTermMatrix (documents: 1390, terms: 1137)>>
## Non-/sparse entries: 7981/1572449
## Sparsity           : 99%
## Maximal term length: 19
## Weighting          : term frequency (tf)
## Sample             :
##       Terms
## Docs   call can come day get just know love now will
##   4243    1   0    0   1   0    0    1    0   0    0
##   4413    1   0    0   0   0    0    0    0   0    0
##   4493    0   1    1   0   0    0    1    0   0    0
##   4515    0   1    0   0   3    0    0    0   0    0
##   4649    1   0    0   0   0    0    0    0   0    0
##   4830    0   2    0   0   1    0    0    0   0    1
##   5068    0   0    0   6   0    0    0    0   0    0
##   5279    0   3    0   0   1    0    0    0   0    0
##   5359    1   2    1   0   1    1    0    0   1    0
##   5488    1   1    0   0   0    1    1    0   0    0

sms_test[c("4243", "4413", "4493", "4515", "4649", "4830", "5068", "5090",
           "5279", "5359"),
          c("call", "can", "come", "day", "free", "get", "just", "like",
            "now", "will")]

##       Terms
## Docs   call  can   come  day   free  get   just  like  now   will 
##   4243 "Yes" "No"  "No"  "Yes" "No"  "No"  "No"  "No"  "No"  "No" 
##   4413 "Yes" "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" 
##   4493 "No"  "Yes" "Yes" "No"  "No"  "No"  "No"  "No"  "No"  "No" 
##   4515 "No"  "Yes" "No"  "No"  "No"  "Yes" "No"  "No"  "No"  "No" 
##   4649 "Yes" "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" 
##   4830 "No"  "Yes" "No"  "No"  "No"  "Yes" "No"  "No"  "No"  "Yes"
##   5068 "No"  "No"  "No"  "Yes" "No"  "No"  "No"  "No"  "No"  "No" 
##   5090 "Yes" "No"  "No"  "No"  "No"  "No"  "No"  "Yes" "No"  "No" 
##   5279 "No"  "Yes" "No"  "No"  "Yes" "Yes" "No"  "No"  "No"  "No" 
##   5359 "Yes" "Yes" "Yes" "No"  "No"  "Yes" "Yes" "No"  "Yes" "No"

ナイーブベイズを行うために必要なデータ【テキスト外】

様々な処理をしてきたので分かりにくいですが、ナイーブベイズで学習を行うために必要なデータは以下の二つのみです。それ以外のデータは全てこれらのデータを作成するためのデータです。

• カテゴライズされたDTM（マトリクス型変数）
• 上記に対するラベルデータ（ベクトル型変数(atomic vector））

sms_train[c("1814", "2046", "295", "2993", "313", "3201", "3507", "3522",
            "399", "808"),
          c("call", "can", "come", "day", "free", "get", "just", "like",
            "now", "will")]

##       Terms
## Docs   call  can   come  day   free  get   just  like  now  will 
##   1814 "Yes" "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No" 
##   2046 "No"  "No"  "No"  "No"  "No"  "No"  "No"  "Yes" "No" "No" 
##   295  "No"  "No"  "No"  "No"  "Yes" "No"  "No"  "Yes" "No" "No" 
##   2993 "No"  "Yes" "No"  "Yes" "No"  "No"  "No"  "No"  "No" "No" 
##   313  "No"  "No"  "Yes" "Yes" "No"  "Yes" "No"  "Yes" "No" "Yes"
##   3201 "No"  "No"  "No"  "No"  "Yes" "No"  "No"  "Yes" "No" "No" 
##   3507 "Yes" "No"  "No"  "No"  "No"  "No"  "Yes" "No"  "No" "Yes"
##   3522 "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No" 
##   399  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No" 
##   808  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No"  "No" "No"

sms_train_labels[c(1814, 2046, 295, 2993, 313, 3201, 3507, 3522,
            399, 808)]

##  [1] ham ham ham ham ham ham ham ham ham ham
## Levels: ham spam

交差検証 【テキスト外】

ナイーブベイズの交差検証はcaretパッケージのcaret::train関数で実行できますが、ナイーブベイズのモデリングに使えるパッケージは下表にあるパッケージのみです。なお、計算には時間がかかりますのでパラレル処理を利用するなどしてください。

cl <- parallel::makePSOCKcluster(4L) 
doParallel::registerDoParallel(cl)

caret::train(x = sms_train, y = sms_train_labels, method = "nb",
             tuneGrid = expand.grid(fL = c(0:5), usekernel = FALSE, adjust = 1),
             trControl = caret::trainControl(method = "cv"))

## Naive Bayes 
## 
## 4169 samples
## 1137 predictors
##    2 classes: 'ham', 'spam' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold) 
## Summary of sample sizes: 3752, 3752, 3752, 3753, 3752, 3751, ... 
## Resampling results across tuning parameters:
## 
##   fL  Accuracy   Kappa      
##   0   0.9791384  0.906909136
##   1   0.9717031  0.883522053
##   2   0.9114979  0.700553444
##   3   0.7080813  0.344592793
##   4   0.2911866  0.056382450
##   5   0.1412808  0.001892734
## 
## Tuning parameter 'usekernel' was held constant at a value of FALSE
## 
## Tuning parameter 'adjust' was held constant at a value of 1
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were fL = 0, usekernel = FALSE
##  and adjust = 1.

parallel::stopCluster(cl)

klaR::NaiveBayes(x = sms_train, grouping = sms_train_labels,
                 fL = 0, usekernel = FALSE, adjust = 1) %>% 
  predict(sms_test) %>% 
  .$class %>%     # e1071::naiveBayes()関数とは返り値が異なるため
  gmodels::CrossTable(sms_test_labels,
                      prop.chisq = FALSE, prop.t = FALSE, prop.r = FALSE,
                      dnn = c('predicted', 'actual'))

## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Col Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  1390 
## 
##  
##              | actual 
##    predicted |       ham |      spam | Row Total | 
## -------------|-----------|-----------|-----------|
##          ham |      1201 |        30 |      1231 | 
##              |     0.995 |     0.164 |           | 
## -------------|-----------|-----------|-----------|
##         spam |         6 |       153 |       159 | 
##              |     0.005 |     0.836 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |      1207 |       183 |      1390 | 
##              |     0.868 |     0.132 |           | 
## -------------|-----------|-----------|-----------|
## 
##