Rで何かをしたり、読書をするブログ

政府統計の総合窓口のデータや、OECDやUCIやのデータを使って、Rの練習をしています。ときどき、読書記録も載せています。

UCI Machine Learning RepositoryのBlood Transfusion Service Centerのデータの分析5 - 決定木モデル(rpart)で予測

www.crosshyou.info

の続きです。前回、前々回と線形モデルで予測してみました。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ではないことがわかります。

今回は以上です。

次回は、

www.crosshyou.info

です。

 

はじめから読むには、

www.crosshyou.info

です。

今回のコードは、

#
# 今回は決定木モデルで予測する
# トレーニング用のデータとテスト用のデータ
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 です。)