UCI Machine Learning Repository の Predict Students' Dropout のデータの分析2 - ロジスティック回帰モデル、Elastic-Net, 決定木モデル、ランダムフォレストモデルでの予測

www.crosshyou.info

の続きです。前回は単純なロジスティック回帰モデルで、ドロップアウトしたか否かのモデルを作成しました。今回は、あらためて、glm(ロジスティック回帰モデル)、glmnet(Elastic-Net), rpart(決定木モデル), ranger(ランダムフォレストモデル)の4つのエンジンを使って、ドロップアウトしたかどうかのモデルを作成します。

はじめにデータフレーム、dfをtibbleに変換しておきます。

Marital_statusのような整数型の変数はカテゴリカル変数なので、これらをファクター型にします。across()関数を使います。

initial_split()関数を使って、トレーニング用、テスト用のデータに分けます。

recipe()関数でレシピを作成します。これは全モデル共通です。

レシピの次はモデルを作成します。それぞれのモデルで別々です。

ワークフローを作成します。workflow()関数にadd_recipe()関数とadd_model()関数で追加します。

クロスバリデーションの設定をします。これは全モデル共通です。

チューニンググリッドを作成します。これは、それぞれのモデルごとです。

tune_grid()関数でチューニングを実行します。glmは不要です。rpartとrangerは結構時間がかかりました。

select_best()関数で最適なパラメータを取り出します。

この最適なパラメータで最終ワークフローを作成します。finalize_workflow()関数を使います。

fit()関数でトレーニング用のデータを使い学習します。

predict()関数でテスト用のデータの予測をします。

roc_auc()関数でROC AUCを計算し、accuracy()関数でAccuracy(正解率)を計算します。

それでは、結果発表の時間です。どのモデルの性能が良かったでしょうか？

ROC AUC, Accuracyともにranger(ランダムフォレストモデル)が一番成績がよかったですね。rpart(決定木モデル)が一番悪く、glm(ロジスティック回帰モデル)とglmnet(Elastic-Net)は同じくらいです。

それでは最後の4つのモデルのROC曲線を描いて終わりましょう。

ランダムフォレストモデルが一番の成績でしたが、glm, glmnetの線形モデルもそれほど悪くはなかったですね。となると、解釈のしやすいglmのロジスティック回帰モデルが実務で使うならいかな、と思いました。

今回は以上です。

はじめから読むには、

www.crosshyou.info

です。

今回のコードは以下になります。

#
# dfをtibbleにする
df <- tibble(df)
df
#
# integerの変数をファクター型にする
df <- df |> mutate(across(where(is.integer), as.factor))
glimpse(df)
#
# ===========================================================
# 1. トレーニング用データ・テスト用データの作成(全モデル共通)
# ===========================================================
set.seed(112233)
split <- initial_split(df, prop = 0.8, strata = Dropout)
train_data <- training(split)
test_data <- testing(split)
#
# =============================
# 2. レシピの作成(全モデル共通)
# =============================
rec <- recipe(Dropout ~ ., data = train_data) |>
step_other(all_nominal_predictors(), threshold = 0.2) |>
step_dummy(all_nominal_predictors()) |>
step_zv() |>
step_normalize(all_numeric_predictors())
#
# ===========================
# 3. モデルの作成(モデルごと)
# ===========================
# 3-1. glm(ロジスティック回帰)
glm_mod <- logistic_reg() |>
set_engine("glm")
#
# 3-2. glmnet(Elastic-Net)
glmnet_mod <- logistic_reg(
penalty = tune(),
mixture = tune()
) |>
set_engine("glmnet")
#
# 3-3. rpart(決定木)
rpart_mod <- decision_tree(
tree_depth = tune(),
min_n = tune(),
cost_complexity = tune()
) |>
set_engine("rpart") |>
set_mode("classification")
#
# 3-4. ranger(ランダムフォレスト)
ranger_mod <- rand_forest(
mtry = tune(),
trees = 1000,
min_n = tune()
) |>
set_engine("ranger") |>
set_mode("classification")
#
# =================================
# 4. ワークフローの作成(モデルごと)
# =================================
# 4-1. glm(ロジスティック回帰)
glm_wf <- workflow() |>
add_recipe(rec) |>
add_model(glm_mod)
#
# 4-2. glmnet(Elastic-Net)
glmnet_wf <- workflow() |>
add_recipe(rec) |>
add_model(glmnet_mod)
#
# 4-3. rpart(決定木)
rpart_wf <- workflow() |>
add_recipe(rec) |>
add_model(rpart_mod)
#
# 4-4. ranger(ランダムフォレスト)
ranger_wf <- workflow() |>
add_recipe(rec) |>
add_model(ranger_mod)
#
# ===========================================
# 5. クロスバリデーションの設定(全モデル共通)
# ===========================================
set.seed(998877)
cv_folds <- vfold_cv(train_data, v = 5)
#
# ===========================================
# 6. チューニング・グリッドの作成(モデルごと)
# ===========================================
# 6-1. glm(ロジスティック回帰)
# チューニングは不要
#
# 6-2. glmnet(Elastic-Net)
glmnet_grid <- grid_regular(
penalty(range = c(-4, 0)),
mixture(range = c(0.2, 0.8)),
levels = c(penalty = 20, mixture = 5)
)
#
# 6-3. rpart(決定木)
rpart_grid <- grid_regular(
cost_complexity(range = c(-4, -1)),
tree_depth(range = c(2, 10)),
min_n(range = c(5, 50)),
levels = 5
)
#
# 6-4. ranger(ランダムフォレスト)
ranger_grid <- grid_regular(
mtry(range = c(3, 20)), # 特徴量数36 → sqrt(36)=6 を中心に
min_n(range = c(2, 20)),
levels = 7
)
#
# =================================
# 7. チューニングの実行(モデルごと)
# ==================================
# 7-1. glm(ロジスティック回帰)
# チューニングは不要
#
# 7-2. glmnet(Elastic-Net)
glmnet_tune <- tune_grid(
glmnet_wf,
resamples = cv_folds,
grid = glmnet_grid,
metrics = metric_set(roc_auc, accuracy),
control = control_grid(save_pred = TRUE)
)
#
# 7-3. rpart(決定木)
rpart_tune <- tune_grid(
rpart_wf,
resamples = cv_folds,
grid = rpart_grid,
metrics = metric_set(roc_auc, accuracy),
control = control_grid(save_pred = TRUE)
)
#
# 7-4. ranger(ランダムフォレスト)
ranger_tune <- tune_grid(
ranger_wf,
resamples = cv_folds,
grid = ranger_grid,
metrics = metric_set(roc_auc, accuracy),
control = control_grid(save_pred = TRUE)
)
#
# =======================
# 8. ベストパラメータ取得
# =======================
# 8-1. glm(ロジスティック回帰)
# 不要
#
# 8-2. glmnet(Elastic-Net)
glmnet_params <- select_best(glmnet_tune, metric = "roc_auc")
glmnet_params
#
# 8-3. rpart(決定木)
rpart_params <- select_best(rpart_tune, metric = "roc_auc")
rpart_params
#
# 8-4. ranger(ランダムフォレスト)
ranger_params <- select_best(ranger_tune, metric = "roc_auc")
ranger_params
#
# ===============================================
# 9. 最適パラメータで最終モデルを作成(モデルごと)
# ===============================================
# 9-1. glm(ロジスティック回帰)
glm_final_wf <- glm_wf
#
# 9-2. glmnet(Elastic-Net)
glmnet_final_wf <- finalize_workflow(glmnet_wf, glmnet_params)
#
# 9-3. rpart(決定木)
rpart_final_wf <- finalize_workflow(rpart_wf, rpart_params)
#
# 9-4. ranger(ランダムフォレスト)
ranger_final_wf <- finalize_workflow(ranger_wf, ranger_params)
#
# ==========================================
# 10. トレーニング用データで学習(モデルごと)
# ==========================================
# 10-1. glm(ロジスティック回帰)
glm_fit <- fit(glm_final_wf, data = train_data)
#
# 10-2. glmnet(Elastic-Net)
glmnet_fit <- fit(glmnet_final_wf, data = train_data)
#
# 10-3. rpart(決定木)
rpart_fit <- fit(rpart_final_wf, data = train_data)
#
# 10-4. ranger(ランダムフォレスト)
ranger_fit <- fit(ranger_final_wf, data = train_data)
#
# ====================================
# 11. テスト用データで予測(モデルごと)
# ====================================
# 11-1. glm(ロジスティック回帰)
glm_pred <- test_data |>
select(Dropout) |>
bind_cols(predict(glm_fit, test_data, type = "class")) |>
bind_cols(predict(glm_fit, test_data, type = "prob"))
#
# 11-2. glmnet(Elastic-Net)
glmnet_pred <- test_data |>
select(Dropout) |>
bind_cols(predict(glmnet_fit, test_data, type = "class")) |>
bind_cols(predict(glmnet_fit, test_data, type = "prob"))
#
# 11-3. rpart(決定木)
rpart_pred <- test_data |>
select(Dropout) |>
bind_cols(predict(rpart_fit, test_data, type = "class")) |>
bind_cols(predict(rpart_fit, test_data, type = "prob"))
#
# 11-4. ranger(ランダムフォレスト)
ranger_pred <- test_data |>
select(Dropout) |>
bind_cols(predict(ranger_fit, test_data, type = "class")) |>
bind_cols(predict(ranger_fit, test_data, type = "prob"))
#
# ==============================
# 12. 予測結果の評価(モデルごと)
# ==============================
# 12-1. glm(ロジスティック回帰)
glm_result <- roc_auc(glm_pred, truth = Dropout, .pred_0) |>
bind_rows(accuracy(glm_pred, truth = Dropout, .pred_class)) |>
mutate(engine = "glm")
#
# 12-2. glmnet(Elastic-Net)
glmnet_result <- roc_auc(glmnet_pred, truth = Dropout, .pred_0) |>
bind_rows(accuracy(glmnet_pred, truth = Dropout, .pred_class)) |>
mutate(engine = "glmnet")
#
# 12-3. rpart(決定木)
rpart_result <- roc_auc(rpart_pred, truth = Dropout, .pred_0) |>
bind_rows(accuracy(rpart_pred, truth = Dropout, .pred_class)) |>
mutate(engine = "rpart")
#
# 12-4. ranger(ランダムフォレスト)
ranger_result <- roc_auc(ranger_pred, truth = Dropout, .pred_0) |>
bind_rows(accuracy(ranger_pred, truth = Dropout, .pred_class)) |>
mutate(engine = "ranger")
#
# ==========================
# 13. ４つのモデルの評価比較
# ==========================
# 13-1. 4つの評価をまとめる
results <- glm_result |>
bind_rows(glmnet_result) |>
bind_rows(rpart_result) |>
bind_rows(ranger_result)
#
# 13-2. ROC AUC
results |>
filter(.metric == "roc_auc") |>
arrange(desc(.estimate))
#
# 13-3. Accuracy
results |>
filter(.metric == "accuracy") |>
arrange(desc(.estimate))
#
# =================
# 14. ROC曲線の描画
# =================
# 14-1. 各モデルのROC曲線データを作成
# 14-1-1. glm(ロジスティック回帰)
glm_roc <- roc_curve(glm_pred, truth = Dropout, .pred_0) %>%
mutate(engine = "glm")
#
# 14-1-2. glmnet(Elastic-Net)
glmnet_roc <- roc_curve(glmnet_pred, truth = Dropout, .pred_0) %>%
mutate(engine = "glmnet")
#
# 14-1-3. rpart(決定木)
rpart_roc <- roc_curve(rpart_pred, truth = Dropout, .pred_0) %>%
mutate(engine = "rpart")
#
# 14-1-4. ranger(ランダムフォレスト)
ranger_roc <- roc_curve(ranger_pred, truth = Dropout, .pred_0) %>%
mutate(engine = "ranger")
#
# 14-2. まとめる
all_roc <- bind_rows(glm_roc, glmnet_roc, rpart_roc, ranger_roc)
#
# 14-3. プロット
ggplot(all_roc, aes(x = 1 - specificity, y = sensitivity, color = engine)) +
geom_line(linewidth = 0.8) +
coord_equal() +
theme_minimal(base_size = 14) +
labs(
title = "ROC Curves for 4 Models",
x = "False Positive Rate (1 - Specificity)",
y = "True Positive Rate (Sensitivity)",
color = "engine"
)
#