の続きです。今回はランダムフォレストで分類してみます。
レシピを作成して、rand_forest()でエンジンをrangerにしてランダムフォレストモデルを作ります。
ワークフロー作成、クロスバリデーションの設定、チューングリッドの作成をします。
チューニング実行して最適なパラメータを見つけ、最終ワークフローを作成し、モデルをフィットします。
テスト用のデータで予測して、予測結果をみてみます。
正解率は89.9%とglmnetでのelastic-net回帰やkknnでのk-NNよりも悪い結果でした。
3つのモデルによる予測があるので、「3人寄れば文殊の知恵」ということで、3つのモデルの多数決はどうなるかみてみましょう。
まず、三つ予測を一つのデータフレームにまとめました。
多数決で結果を返す関数を自作します。
この関数をall_predに適用します。
混合行列を作成します。
お！間違いが9個しかないです。いい感じですね。
正解率を計算します。
多数決の正解率が93.5%で一番でした。
まさに「3人寄れば文殊の知恵」でした。
今回は以上です。
はじめから読むには、
です。
今回のコードは以下になります。
#
# Random Forest
# Step 1. レシピ作成
rf_rec <- recipe(type ~ date + amt + series, data = df_train) |>
step_dummy(all_nominal_predictors()) |>
step_zv(all_predictors()) |>
step_normalize(all_numeric_predictors())
#
# Step 2. モデル作成
rf_mod <- rand_forest(
mtry = tune(),
trees = 1000,
min_n = tune()
) |>
set_engine("ranger", importance = "impurity") |>
set_mode("classification")
#
# Step 3. ワークフロー作成
rf_wf <- workflow() |>
add_recipe(rf_rec) |>
add_model(rf_mod)
#
# Step 4. クロスバリデーションの設定
rf_folds <- glmnet_folds # glmnetのものを使う
#
# Step 5. チューングリッドの作成
rf_grid <- crossing(
mtry = 1:3,
min_n = 3:20
)
#
# Step 5. チューニング実行
set.seed(2)
rf_tuned <- tune_grid(
rf_wf,
resamples = rf_folds,
grid = rf_grid,
metrics = metric_set(accuracy, roc_auc)
)
#
# Step 6. 最適なパラメータ
rf_params <- select_best(rf_tuned, metric = "accuracy")
rf_params
#
# Step 7. 最終ワークフロー
rf_final_wf <- finalize_workflow(rf_wf, rf_params)
#
# Step 8. 最終フィット
set.seed(2)
rf_fit <- fit(rf_final_wf, data = df_train)
#
# Step 9. テスト用のデータで予測
rf_pred <- predict(rf_fit, new_data = df_test)
#
# Step 10. Confusion Matrix
rf_cm <- table(rf_pred$.pred_class, df_test$type)
rf_cm
#
# Step 11. 正解率
rf_accuracy <- sum(diag(rf_cm)) / sum(rf_cm)
rf_accuracy
glmnet_accuracy
knn_accuracy
#
# 3つの予測を合体
all_pred <- tibble(
glmnet = glmnet_pred$.pred_class,
knn = knn_pred$.pred_class,
rf = rf_pred$.pred_class
)
all_pred
#
# 多数決の関数
ooi <- function(x) {
tbl <- table(x)
ichi <- which.max(tbl)
names(tbl)[ichi]
}
#
# all_predの多数決
tasu_pred <- apply(all_pred, 1, ooi)
#
# 多数決の混合行列
tasu_cm <- table(tasu_pred, df_test$type)
tasu_cm
#
# 多数決の正解率
tasu_accuracy <- sum(diag(tasu_cm)) / sum(tasu_cm)
tasu_accuracy
glmnet_accuracy
knn_accuracy
rf_accuracy
#
(冒頭の画像は Bing Image Creator で生成しました。プロンプトは、splendid moment of landscape, natural wild land, close up of white lily flower, under blue bright sky, Photo です。)
