の続きです。今回はglmnetエンジンでペナルティ付きのロジスティクス回帰モデルを試してみます。
まず、トレーニング用のデータフレームとテスト用のデータフレームを作ります。
glmnetエンジンでペナルティ付きのロジスティクス回帰モデルならば、重要でない変数は自動的に削除されますから、各説明変数の2乗項、平方根項、交差項を追加してみました。
tidymodelsのlogistic_reg()でモデルを設定します。
penaltyというものがglmnetでのlambdaに相当して、mixtureというものがalphaに相当します。これは、後でチューニングして最適な数値を調べますので、この段階では、tune()としておきます。
recipe()でレシピを設定します。
前処理として、step_normalize()で変数を標準化しておきます。
workflow()でワークフローを設定します。
チューニング用のグリッドを設定します。
クロスバリデーションの設定をします。
tune_grid()でチューニングを実行します。
select_best()で最良のパラメータを取り出します。
この最良のパラメータでモデルを学習します。
テスト用のデータで予測します。
モデルを確認しておきましょう。どの変数が使われているでしょうか？
全ての変数が使われていますね。Frsq, Frequencyの平方根が切片を除くと、絶対値ベースで一番大きな係数をもっています。2番目はRecencyですね。
conf_mat()で混合行列をみてみます。
正解率などの評価指標をみてみます。
正解率は79.8%です。前回のシンプルなロジスティクス回帰モデルの正解率は78.7%でしたので、1%くらいこちらのほうが正解率が良いです。
ROC曲線のAUCを計算します。
0.681でした。前回のシンプルなロジスティクス回帰モデルのAUCは0.671でしたので、こちらのほうが0.01だけ良いです。
ROC曲線を描いてみます。前回のシンプルなロジスティクス回帰モデルのROC曲線と今回のペナルティ付きのロジスティクス回帰モデル(Elastic-Net)のROC曲線を一緒に描画します。
まず、ステップ1として両者のデータをroc_curve()で作ります。
ステップ2として二つのデータをbind_rows()で結合します。
そうしたら、ggplotでグラフを描きます。
両者にそれほど大きな違いは無いようです。線形モデルでの分類はこのような感じ
でしょうかね。
今回は以上です。
次回は
です。
はじめから読むには、
です。
今回のコードは以下になります。
#
# 今回はglmnetエンジンでElastic-Net回帰モデル
# 今回用のトレーニング用データとテスト用データの作成
df_glmnet_train <- training(split) |>
mutate(Donated_Blood = as.factor(Donated_Blood),
Rec2 = Recency^2,
Fre2 = Frequency^2,
T2 = Time^2,
Resq = sqrt(Recency),
Frsq = sqrt(Frequency),
Tsq = sqrt(Time),
ReTi = Recency * Time,
FrTi = Frequency * Time,
ReFr = Recency * Frequency,
ReFrTi = Recency * Frequency * Time)
#
df_glmnet_test <- testing(split) |>
mutate(Donated_Blood = as.factor(Donated_Blood),
Rec2 = Recency^2,
Fre2 = Frequency^2,
T2 = Time^2,
Resq = sqrt(Recency),
Frsq = sqrt(Frequency),
Tsq = sqrt(Time),
ReTi = Recency * Time,
FrTi = Frequency * Time,
ReFr = Recency * Frequency,
ReFrTi = Recency * Frequency * Time)
#
# モデル仕様
glmnet_mod <- logistic_reg(
penalty = tune(), # lambda
mixture = tune() # alpha
) |>
set_engine("glmnet")
#
# レシピ
glmnet_rec <- recipe(Donated_Blood ~ ., data = df_glmnet_train) |>
step_normalize(all_numeric_predictors())
#
# ワークフロー
glmnet_wf <- workflow() |>
add_model(glmnet_mod) |>
add_recipe(glmnet_rec)
#
# チューニング用のグリッド
glmnet_grid <- grid_regular(
penalty(range = c(-4, 1)), # 10^-4 ~ 10^1
mixture(),
levels = 10
)
#
# クロスバリデーション
set.seed(123987)
folds <- vfold_cv(df_glmnet_train, v = 5)
#
# チューニング実行
glmnet_tune <- tune_grid(
glmnet_wf,
resamples = folds,
grid = glmnet_grid,
metrics = metric_set(roc_auc, accuracy)
)
#
# 最良パラメータ
glmnet_params <- select_best(glmnet_tune, metric = "roc_auc")
glmnet_params
#
# 最終モデルの作成
glmnet_final_wf <- finalize_workflow(glmnet_wf, glmnet_params)
glmnet_final_fit <- fit(glmnet_final_wf, data = df_glmnet_train)
#
# テスト用のデータで予測
glmnet_results <- df_glmnet_test |>
select(Donated_Blood) |>
bind_cols(
predict(glmnet_final_fit, new_data = df_glmnet_test,
type = "class"),
predict(glmnet_final_fit, new_data = df_glmnet_test,
type = "prob"))
glmnet_results
#
# モデルの中身を確認
glmnet_final_fit |>
extract_fit_parsnip() |>
tidy()
#
# 混合行列
glmnet_results |>
conf_mat(truth = Donated_Blood, estimate = .pred_class)
#
# 各種指標
metrics <- metric_set(accuracy, sensitivity, specificity)
metrics(glmnet_results, truth = Donated_Blood, estimate = .pred_class)
#
# ROC AUC
roc_auc(glmnet_results, truth = Donated_Blood, .pred_0)
#
# ROC曲線(logitとglmnet)
# Step1. ROC 曲線データを作成
logit_roc <- roc_curve(logit_result, truth = Donated_Blood, .pred_0) |>
mutate(model = "logit")
#
glmnet_roc <- roc_curve(glmnet_results, truth = Donated_Blood, .pred_0) |>
mutate(model = "glmnet")
#
# Step2. 結合
roc_all <- bind_rows(logit_roc, glmnet_roc)
#
# Step3. プロット
roc_all |>
ggplot(aes(x = 1 - specificity, y = sensitivity, color = model)) +
geom_path(size = 1.2) +
geom_abline(lty = 2, color = "gray50") +
coord_equal() +
theme_minimal() +
labs(title = "ROC Curves for Two Models",
x = "1 - Specificity (False Positive Rate)",
y = "Sensitivity (True Positive Rate)")
#
(冒頭の画像は、Bing Image Creatorで生成しました。プロンプトは、Photograph of beautiful landscape, there is close up of white Cyclamen and pink Cyclamen flowers, beautiful white clouds in the bule sky. です。)
