の続きです。今回はナイーブ・ベイズモデルで分類してみましょう。
使用するパッケージは、e1071を使います。
モデルを生成する関数は、naiveBayes()です。そのままの名前ですね。
predict()関数で予測して、table()関数で結果を確認します。
正解率は、(1 + 7 + 335 + 369 + 162 + 4 + 0) / 1950 = 45.0% でした。
ちょっと低い正解率ですね。
正解率を上げるヒントをCopilotに尋ねたところ、特徴量を離散型の数値にするといいらしいです。
ちょっとやってみましょう。とりあえず、ナイーブベイズ用のデータフレームを作っておきましょう。
fixed_acidity ~ alcoholまでの変数が連続型数値変数なので、これを離散型に変換しましょう。
まず、連続型変数を離散型の変数にする関数を自作しました。
この関数がうまくいくかテストします。
rnorm(100)で生成された数値型のベクトルが離散型のベクトルに変換できました。
この関数をfixed_acidity ~ acloholまで適用します。
うまく変換できました。
ここで、再度、naiveBayes()関数モデルを生成して、予測、評価します。
正解率は (4 + 415 + 344 + 153 + 2) / 1950 = 47.2%でした。
少し正解率は上がりましたが、他のモデルと比較すると低いですね。
今回は以上です。
はじめから読むには、
です。
今回のコードは以下になります。
#
# ナイーブ・ベイズ
#
# パッケージの読み込み
library(e1071)
#
# トレーニングデータでモデル生成
set.seed(345)
nb_model <- naiveBayes(quality ~ ., data = df_ranger[idx, ])
#
# テストデータで予測, 評価
nb_pred <- predict(nb_model, newdata = df_ranger[-idx, ])
table(Predicted = nb_pred, Actual = df_ranger$quality[-idx])
#
# 正解率
(1 + 7 + 335 + 369 + 162 + 4) / nrow(df_ranger[-idx, ])
#
# ナイーブベイズ用のデータを作る
df_nb <- df_ranger
glimpse(df_nb)
#
# 連続型ベクトルを離散型ベクトルに変換する関数を作成
make_risan <- function(x) {
# 四分位点を取得
q <- quantile(x, probs = c(0, 0.25, 0.5, 0.75, 1))
# 離散化：1〜4のラベルを付ける
x_discrete <- cut(x,
breaks = q,
labels = c(1, 2, 3, 4),
include.lowest = TRUE,
right = FALSE) # 区間の右端を含まない
# 結果を返す
return(x_discrete)
}
#
# 自作関数のテスト
test_vector <- rnorm(100)
summary(test_vector)
make_risan(test_vector) |> summary()
#
# make_risan()関数で離散型のベクトルにする
df_nb <- df_nb |>
mutate(
across(
.cols = fixed_acidity:alcohol,
.fns = make_risan
)
)
glimpse(df_nb)
#
# ナイーブベイズ・モデル
nb_model2 <- naiveBayes(quality ~ ., data = df_nb[idx, ])
#
# テストデータで予測
nb_pred2 <- predict(nb_model2, newdata = df_nb[-idx, ])
#
# 実際の値と比較
table(Predicted = nb_pred2, Actual = df_nb$quality[-idx])
#
# 正解率
(4 + 415 + 344 + 153 + 2) / nrow(df_nb[-idx, ])
#
(冒頭の画像は、Bing Image Creator で生成しました。プロンプトは Landscape photograph of nature green potmam flowers fileld, blue clear sky です。)
