賃金構造基本調査のデータ分析 9 - tidymodelsの ranger エンジンでランダムフォレストモデルによる回帰分析。

www.crosshyou.info

の続きです。今回はランダムフォレストモデルで予測してみます。ranger エンジンを使用しました。

ranger パッケージを読み込みます。

モデルを定義します。rand_forest() でエンジンは ranger です。

レシピを定義します。

ワークフローを構築します。

クロスバリデーションの設定をします。

チューニング・グリッドを作成します。

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

最適なパラメータを確認します。

mtry = 4, min_n = 20 が最適パラメータでした。

この最適なパラメータで最終モデルを生成し、学習します。

df_test のデータで予測します。predict() 関数を使います。

実際の df_test の saraly と並べて表示してみます。

グラフを描いてみましょう。

RMSEを計算します。果たして、前回の k-NN法よりも小さなRMSEになるでしょうか？

49.5 と k-NN法の50.0よりも小さな値になりました。

今回は以上です。

次回は

www.crosshyou.info

です。

はじめから読むには、

www.crosshyou.info

です。

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

#
# 1. ranger パッケージを読み込む
library(ranger)
#
# 2. モデルを定義
rf_model <- rand_forest(
mode = "regression",
mtry = tune(), # チューニング対象
min_n = tune(), # チューニング対象
trees = 500 # 決定木の数
) |>
set_engine("ranger")
rf_model
#
# 3. レシピを定義(標準化など)
rf_rec <- recipe(saraly ~ ., data = df_training) |>
step_normalize(all_numeric_predictors())
rf_rec
#
# 4. ワークフロー構築
rf_wf <- workflow() |>
add_model(rf_model) |>
add_recipe(rf_rec)
rf_wf
#
# 5. クロスバリデーションの設定
set.seed(333)
rf_folds <- vfold_cv(df_training, v = 5)
rf_folds
#
# 6. チューニング・グリッドの作成
rf_grid_vals <- grid_regular(
mtry(range = c(1, 7)),
min_n(range = c(2, 20)),
levels = 5
)
rf_grid_vals
#
# 7. チューニング実行
set.seed(951)
rf_tunes <- tune_grid(
rf_wf,
resamples = rf_folds,
grid = rf_grid_vals,
metrics = metric_set(rmse)
)
rf_tunes
#
# 8. 最適パラメータの選択
rf_best_params <- select_best(rf_tunes, "rmse")
rf_best_params
#
# 9. 最終モデルの作成と学習
set.seed(369)
rf_final_wf <- finalize_workflow(rf_wf, rf_best_params)
rf_final_fit <- fit(rf_final_wf, data = df_training)
rf_final_fit
#
# 10. df_testのデータで予測
rf_pred <- predict(rf_final_fit, new_data = df_test)
rf_pred
#
# 11. df_test の saraly と並べて表示
df_test |>
select(saraly) |>
bind_cols(rf_pred)
#
# 12. グラフ
df_test |> bind_cols(rf_pred) |>
ggplot(aes(x = saraly, y = .pred)) +
geom_point() +
geom_abline(intercept = 0, slope = 1, color = "red") +
coord_cartesian(xlim = c(100, 800), ylim = c(100, 800))
#
# 13. RMSEの計算
# random forestのRMSE
df_test |> bind_cols(rf_pred) |>
summarize(RMSE = sqrt(mean*1 |>
summarize(RMSE = sqrt(mean((saraly - .pred)^2)))
#

(冒頭の画像は Bing Image Creator で生成しました。プロンプトは、In a primeval-era grassland, white and yellow flowers bloom in abundance. The sky feels clear and pure, with just two or three clouds floating gently above.
PHOTO です。)