の続きです。前回はDonated_Bloodと他の変数の関係を箱ひげ図で視覚化しました。今回はDonated_Bloodを予測するモデルを作ります。まずは、2値の分類問題では基本のロジスティクスモデルを試します。
前もって、tidymodelsパッケージの読み込みをしておきます。
次は、dfをトレーニング用とテスト用にわけます。
initial_split()関数を使いました。prop = 0.75として、トレーニング用のデータを全体の75%に、テスト用のデータを残りの25%にしました。strata = Donated_Bloodとして、Donated_Bloodがトレーニング用のデータとテスト用のデータに均等に振り分けられるようようにしました。そして、mutate()関数の中でas.factor()関数を使ってDonated_Bloodをファクター型にしています。
２つのデータフレームのサマリー統計値とみてみます。
トレーニング用のデータのDonated_Bloodが1の割合は、133/(133+427)=0.2375で、テスト用のデータは45/(45+143)=0.2394なので、だいたい同じです。
次は、レシピを作ります。recipe()関数を使います。今回は変数を標準化するなどの処理はしないシンプルなレシピです。
次は、logistic_reg()関数でロジスティクス回帰分析モデルを作ります。
そして、workflow()関数でワークフローを作ります。
ワークフローができたら、fit()関数で学習します。
predict()関数でテスト用のデータの予測をします。
0になる確率が.pred_0の変数に、1になる確率が.pred_1の変数に格納されています。
この予測結果をdf_trainと合体させます。
Donated_Bloodが実際の値で、pred_classがロジスティクス回帰モデルから予測された値です。
まずは、混合行列をみてみます。
モデルでは0と予測したのに実際は1だったというケースが38個ありますね。
正解率などの評価値をみてみます。
正解率は78.7%でした。
ROC AUCを計算します。
ROC AUCは0.671です。
ROC曲線を描きます。
ロジスティクス回帰モデルでは、正解率は0.787, ROC AUCは0.671でした。
次回からは他のモデルで、これ以上の予測結果を目指していこうと思います。
今回は以上です。
次回は、
です。
はじめから読むには、
です。
今回のコードは以下になります。
#
# tidymodelsを読み込む
library(tidymodels)
#
# dfをトレーニング用とテスト用に分ける
set.seed(13579)
split <- initial_split(df, prop = 0.75, strata = Donated_Blood)
df_train <- training(split) |>
mutate(Donated_Blood = as.factor(Donated_Blood))
df_test <- testing(split) |>
mutate(Donated_Blood = as.factor(Donated_Blood))
#
# トレーニング用とテスト用のサマリー統計値
summary(df_train)
summary(df_test)
#
# ロジスティクス回帰モデル
# レシピ
logit_rec <- recipe(Donated_Blood ~ Recency + Frequency + Time,
data = df_train)
#
# モデル
logit_mod <- logistic_reg() |>
set_engine("glm", family = "binomial") |>
set_mode("classification")
#
# ワークフロー
logit_wf <- workflow() |>
add_recipe(logit_rec) |>
add_model(logit_mod)
#
# 学習
logit_fit <- logit_wf |>
fit(data = df_train)
#
# テスト用データで予測
logit_pred <- predict(logit_fit, new_data = df_test, type = "prob")
logit_pred
#
# 結果のデータフレーム
logit_result <- df_test |>
cbind(logit_pred) |>
mutate(pred_class = if_else(.pred_0 > 0.5, 0, 1)) |>
mutate(pred_class = as.factor(pred_class)) |>
as_tibble()
logit_result
#
# 混合行列
logit_result |>
conf_mat(truth = Donated_Blood, estimate = pred_class)
#
# 各種指標
metrics <- metric_set(accuracy, sensitivity, specificity)
metrics(logit_result, truth = Donated_Blood, estimate = pred_class)
#
# ROC AUC
roc_auc(logit_result, truth = Donated_Blood, .pred_0)
#
# ROC曲線
roc_curve(logit_result, truth = Donated_Blood, .pred_0) |>
autoplot()
#
(冒頭の画像は、Bing Image Creatorで生成しました。プロンプトは、a little mysterious tone, landscape of natural grass field, there is a small pond at the lower left corner, there are very colorful flowers in the lower right corner, photo です。)
