都道府県別の商業動態統計調査のデータの分析8 - 7つのモデルの予測結果比較

www.crosshyou.info

の続きです。前回は、tune_grid()関数でハイパーパラメータのチューニングをしました。

今回はチューニング結果を見るところからはじめます。collect_metrics()関数を使います。

線形モデル(lm)をみてみます。

rmseは2.30です。R-squaredは0.311です。

次は、ペナルティ付き線形モデル(glmnet)です。

rmseの最小は、2.22でした。

次は決定木モデル(rpart)です。

2.48が最小です。

次はランダムフォレストモデル(ranger)です。

2.08です。

次は、サポートベクター回帰(SVR)モデルです。(kernlab)

2.17が最小でした。

k-NN回帰モデル(kknn)はどうでしょうか？

2.18が最小でした。

最後はニューラルネットワークモデル(nnet)です。

次は、select_best()関数で最適なパラメータを取り出します。

この最適なパラメータで、最終ワークフローを作成します。finalize_workflow()関数を使います。

最終ワークフローが作成できたら、fit()関数で、train_dataをつかって学習します。

これでモデルが学習できました。あともう少しです。predict()関数でtest_dataの予測をします。

予測結果をみていきましょう。まず全ての予測結果を統合します。

RMSEから見ていきます。

決定木モデル(rpart)が一番小さいRMSEでした。このRMSEの値でZスコアを計算しています。このZスコアは後で総合評価を決定するときに使います。2番目はランダムフォレストモデル(ranger)で、3番目はペナルティ付き線形モデル(glmnet)でした。

MAEはどうでしょうか？

RMSEでは一番成績がよかった決定木モデル(rpart)がMAEでは一番悪い結果です。1番MAEが小さいのはランダムフォレストモデル(ranger)です。

R-squaredの結果を見てみます。

ランダムフォレストモデル(ranger)が一番の成績です。

それでは、RMSE、MAE、R-squaredの3つの総合をみてみます。scoreの平均値で決定します。

ランダムフォレストモデル(ranger)が一番良いモデルでした。2番目は線形モデル(lm)で、3番目はペナルティ付き線形モデル(glmnet)でした。線形モデル、あなどれませんね。

今回は以上です。

次回は

www.crosshyou.info

です。

はじめから読むには、

www.crosshyou.info

です。

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

# 7. 性能確認
# 7-1. 線形モデル(lm)
collect_metrics(lm_tuned)
#
# 7-2. ペナルティ付き線形モデル(glmnet)
collect_metrics(glmnet_tuned) |>
filter(.metric == "rmse") |>
arrange(mean) |>
relocate(mean)
#
# 7-3. 決定木モデル(rpart)
collect_metrics(rpart_tuned) |>
filter(.metric == "rmse") |>
arrange(mean) |>
relocate(mean)
#
# 7-4. ランダムフォレストモデル(ranger)
collect_metrics(ranger_tuned) |>
filter(.metric == "rmse") |>
arrange(mean) |>
relocate(mean)
#
# 7-5. サポートベクター回帰(SVR)モデル(kernlab)
collect_metrics(kernlab_tuned) |>
filter(.metric == "rmse") |>
arrange(mean) |>
relocate(mean)
#
# 7-6. k-NN回帰モデル(kknn)
collect_metrics(kknn_tuned) |>
filter(.metric == "rmse") |>
arrange(mean) |>
relocate(mean)
#
# 7-7. ニューラルネットワークモデル(nnet)
collect_metrics(nnet_tuned) |>
filter(.metric == "rmse") |>
arrange(mean) |>
relocate(mean)
#
#
# 8ベストパラメータ
# 8-1. 線形モデル(lm)
# 線形モデルはパラメータは無し
#
# 8-2. ペナルティ付き線形モデル(glmnet)
glmnet_params <- glmnet_tuned |>
select_best(metric = "rmse")
glmnet_params
#
# 9-3. 決定木モデル(rpart)
rpart_params <- rpart_tuned |>
select_best(metric = "rmse")
rpart_params
#
# 9-4. ランダムフォレストモデル(ranger)
ranger_params <- ranger_tuned |>
select_best(metric = "rmse")
ranger_params
#
# 9-5. サポートベクター回帰(SVR)モデル(kernlab)
kernlab_params <- kernlab_tuned |>
select_best(metric = "rmse")
kernlab_params
#
# 9-6. k-NN回帰モデル(kknn)
kknn_params <- kknn_tuned |>
select_best(metric = "rmse")
kknn_params
#
# 9-7. ニューラルネットワークモデル(nnet)
nnet_params <- nnet_tuned |>
select_best(metric = "rmse")
nnet_params
#
# 10. 最終ワークフロー
# 10-1. 線形モデル(lm)
lm_wf_f <- lm_wf #線形モデルはワークフローと同じ
#
# 10-2. ペナルティ付き線形モデル(glmnet)
glmnet_wf_f <- finalize_workflow(glmnet_wf, glmnet_params)
#
# 10-3. 決定木モデル(rpart)
rpart_wf_f <- finalize_workflow(rpart_wf, rpart_params)
#
# 10-4. ランダムフォレストモデル
ranger_wf_f <- finalize_workflow(ranger_wf, ranger_params)
#
# 10-5. サポートベクター回帰(SVR)回帰モデル(kernlab)
kernlab_wf_f <- finalize_workflow(kernlab_wf, kernlab_params)
#
# 10-6. k-NN回帰モデル(kknn)
kknn_wf_f <- finalize_workflow(kknn_wf, kknn_params)
#
# 10-7. ニューラルネットワークモデル(nnet)
nnet_wf_f <- finalize_workflow(nnet_wf, nnet_params)
#
#
# 11. 最終トレーニング
# 11-1. 線形モデル(lm)
lm_fit <- fit(lm_wf_f, train_data)
#
# 11-2. ペナルティ付き線形モデル(glmnet)
glmnet_fit <- fit(glmnet_wf_f, train_data)
#
# 11-3. 決定木モデル(rpart)
rpart_fit <- fit(rpart_wf_f, train_data)
#
# 11-4. ランダムフォレストモデル(ranger)
ranger_fit <- fit(ranger_wf_f, train_data)
#
# 11-5. サポートベクター回帰(SVR)モデル(kernlab)
kernlab_fit <- fit(kernlab_wf_f, train_data)
#
# 11-6. k-NN回帰モデル(kknn)
kknn_fit <- fit(kknn_wf_f, train_data)
#
# 11-7. ニューラルネットワークモデル(nnet)
nnet_fit <- fit(nnet_wf_f, train_data)
#
#
# 12. テスト用データで予測
# 12-1. 線形モデル(lm)
lm_pred <- test_data |>
select(target) |>
bind_cols(predict(lm_fit, test_data)) |>
mutate(model = "lm")
#
# 12-2. ペナルティ付き線形モデル
glmnet_pred <- test_data |>
select(target) |>
bind_cols(predict(glmnet_fit, test_data)) |>
mutate(model = "glmnet")
#
# 12-3. 決定木モデル(rpart)
rpart_pred <- test_data |>
select(target) |>
bind_cols(predict(rpart_fit, test_data)) |>
mutate(model = "rpart")
#
# 12-4. ランダムフォレストモデル(ranger)
ranger_pred <- test_data |>
select(target) |>
bind_cols(predict(ranger_fit, test_data)) |>
mutate(model = "ranger")
#
# 12-5. サポートベクター回帰(SVR)モデル(kernlab)
kernlab_pred <- test_data |>
select(target) |>
bind_cols(predict(kernlab_fit, test_data)) |>
mutate(model = "kernlab")
#
# 12-6. k-NN回帰モデル(kknn)
kknn_pred <- test_data |>
select(target) |>
bind_cols(predict(kknn_fit, test_data)) |>
mutate(model = "kknn")
#
# 12-7. ニューラルネットワークモデル(nnet)
nnet_pred <- test_data |>
select(target) |>
bind_cols(predict(nnet_fit, test_data)) |>
mutate(model = "nnet")
#
#
# 12-9. 全ての予想を統合
pred_results <- lm_pred |>
bind_rows(glmnet_pred, rpart_pred, ranger_pred, kernlab_pred, kknn_pred,
nnet_pred)
#
# 13. 結果発表
# 13-1. RMSE
results_rmse <- pred_results |>
group_by(model) |>
rmse(truth = target, estimate = .pred) |>
arrange(.estimate) |>
mutate(score = scale(.estimate) |> as.numeric() * -1)
results_rmse
#
# 13-2. MAE
results_mae <- pred_results |>
group_by(model) |>
mae(truth = target, estimate = .pred) |>
arrange(.estimate) |>
mutate(score = scale(.estimate) |> as.numeric() * -1)
results_mae
#
# 13-3 R-Square
results_rsq <- pred_results |>
group_by(model) |>
rsq(truth = target, estimate = .pred) |>
arrange(desc(.estimate)) |>
mutate(score = scale(.estimate) |> as.numeric())
results_rsq
#
# 13-4. 総合評価
results_rmse |>
bind_rows(results_mae, results_rsq) |>
group_by(model) |>
summarize(total_score = mean(score)) |>
arrange(desc(total_score))
#