
の続きです。前回、前々回と線形モデルで予測してみました。80%よりちょっと下の正解率でした。今回は線形モデルでなく、決定木モデルで予測してみます。
まず、トレーニング用のデータフレームとテスト用のデータフレームを用意します。

レシピを作成します。

モデルを作成します。エンジンは、rpartを使いました。

チューニングのパラメータは、cost_complexity(事後剪定の強さ), tree_depth(木の深さ),
min_n(ノードの最小データ数)の3つです。

チューニング・グリッドを作成します。grid_regula()でlevels = 4に設定して、4 * 4 * 4 = 64個のパラメータの組み合わせを作成します。

チューニングを実行します。

最良パラメータを決定します。

最良パラメータを使って最終モデル学習します。

テスト用のデータで予測します。

混合行列をみてみます。

正解率を計算します。

正解率は77.1%です。線形モデルよりも悪いです。
ROC曲線のAUCを計算します。

0.681でした。glmnetエンジンのElastic-Netのモデルと同じ値ですね。
ROC曲線を描きましょう。


青いラインが今回の決定木モデルで予測したROC曲線です。何故か対角線上にも青いラインがありますが、線形モデルとそんなに違うAUCではないことがわかります。
今回は以上です。
次回は、
です。
はじめから読むには、
です。
今回のコードは、
#
# 今回は決定木モデルで予測する
# トレーニング用のデータとテスト用のデータ
df_tree_train <- training(split) |>
mutate(Donated_Blood = as.factor(Donated_Blood))
df_tree_test <- testing(split) |>
mutate(Donated_Blood = as.factor(Donated_Blood))
#
# レシピ作成
tree_rec <- recipe(Donated_Blood ~ ., data = df_tree_train)
#
# モデル作成
tree_mod <- decision_tree(
cost_complexity = tune(), # 事後剪定の強さ
tree_depth = tune(), # 木の深さ
min_n = tune() # ノードの最小データ数
) |>
set_engine("rpart") |>
set_mode("classification")
#
# ワークフロー作成
tree_wf <- workflow() |>
add_model(tree_mod) |>
add_recipe(tree_rec)
#
# チューニング・グリッドの作成
tree_grid <- grid_regular(
cost_complexity(),
tree_depth(),
min_n(),
levels = 4
)
tree_grid
#
# チューニングの実行
set.seed(123)
tree_tuned <- tune_grid(
tree_wf,
resamples = folds,
grid = tree_grid,
metrics = metric_set(roc_auc, accuracy)
)
#
# 最良パラメータ
tree_params <- select_best(tree_tuned, metric = "roc_auc")
tree_params
#
# 最良パラメータで最終モデル
tree_final_wf <- finalize_workflow(tree_wf, tree_params)
tree_final_fit <- fit(tree_final_wf, data = df_tree_train)
#
# テスト用のデータで予測
tree_results <- df_tree_test |>
select(Donated_Blood) |>
bind_cols(
predict(tree_final_fit, new_data = df_tree_test, type = "class"),
predict(tree_final_fit, new_data = df_tree_test, type = "prob")
)
tree_results
#
# 混合行列
tree_results |>
conf_mat(truth = Donated_Blood, estimate = .pred_class)
#
# 各種指標
metrics <- metric_set(accuracy, sensitivity, specificity)
metrics(tree_results, truth = Donated_Blood, estimate = .pred_class)
#
# ROC AUC
roc_auc(glmnet_results, truth = Donated_Blood, .pred_0)
#
# ROC曲線
# Step1. ROC曲線データを作成
tree_roc <- roc_curve(tree_results, truth = Donated_Blood, .pred_0) |>
mutate(model = "tree")
#
# Step2. 結合
roc_all <- roc_all |>
bind_rows(tree_roc)
#
# Step3. プロット
roc_all |>
ggplot(aes(x = 1 - specificity, y = sensitivity, color = model)) +
geom_path(linewidth = 1.2) +
geom_abline(lty = 2, color = "gray50") +
coord_equal() +
labs(title = "ROC曲線(logit, glmnet, tree))",
x = "1 - Specificity (False Posivie Rate)",
y = "Sencitivity (True Positive Rate") +
theme_bw()
#
(冒頭の画像は、Bing Image Creatorで生成しました。プロンプトは、Beautiful and mysterious place, there is a very large fantastic tree peony tree flower, bright tone photo です。)