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

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

都道府県別の定期健康診断結果報告のデータの分析6 - 決定木モデルでの回帰分析

www.crosshyou.info

の続きです。前回は lm() 関数を使って、線形モデルで重回帰分析をしました。R-squared は 0.22 ということで残念ながら線形モデルでは、所見率は上手く説明できないようでした。そこで今回は決定木モデルを使ってみます。

はじめに rpart パッケージ、rpart.plot パッケージの読み込みをします。

モデルを作成します。

cp の確認をします。

cp = 0.01 のときが一番、xerror が小さくなります。

最適な cp を保存して、この cp で木の選定をします。

作成した決定木をグラフにします。

一番左の枝に注目すると、log_jushin が 12 以上で、さらに per_jushin が 118 以上だと、shokenritsu は 52 となる、ということです。

このモデルの予想値と実際の値を散布図にしてみます。

前回の線形モデルと今回の決定木モデルを比較してみます。RMSEと相関係数を比較します。

RMSEは線形モデルが 3.18 なのに対して、決定木モデルは 2.51 と 21% も低下しました。相関係数は、線形モデルが 0.473 なのに対して、決定木モデルは 0.720 と 52% も改善しています。shokenritsu は per_jushin, log_place, log_jushin に対しては線形の関係ではないことがわかりますね。

最後に線形モデルと決定木モデルの予測値と実際の値の散布図を描いてみます。

青い T が決定木モデルの予測値、赤い L が線形モデルの予測値です。黒い直線が傾き 1, 切片 0 の直線です。

今回は以上です。

次回は

www.crosshyou.info

です。

 

はじめから読むには、

www.crosshyou.info

です。

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

#
# rpartパッケージで tree model で regression
#
library(rpart)
library(rpart.plot)
#
# モデルを作成
set.seed(277)
rpart_mod <- rpart(
  shokenritsu ~ per_jushin + log_place + log_jushin,
  data = df,
  method = "anova"
)
#
# cp の確認
printcp(rpart_mod)
plotcp(rpart_mod)
#
# 最適 cp で剪定
best_cp <- rpart_mod$cptable[which.min(rpart_mod$cptable[,"xerror"]), "CP"]
best_cp
pruned_rpart <- prune(rpart_mod, cp = best_cp)
#
# 木の可視化
rpart.plot(pruned_rpart)
#
# 予測
tree_pred <- predict(pruned_rpart, newdata = df)
#
# 予測値と実際の値の散布図
tibble(
  estimate = tree_pred,
  actual = df$shokenritsu
) |> 
  ggplot(aes(x = estimate, y = actual)) +
  geom_point() +
  geom_abline(intercept = 0, slope = 1, color = "red") +
  theme_minimal()
#
# Linear Modelの予測とTree ModelのRMSE, 相関の比較
lm_pred <- predict(lm_mod4v5, newdata = df)
df_rmse <- tibble(
  Model = c("Linear", "Tree"),
  RMSE = c(sqrt(mean*1,
           sqrt(mean*2
)
df_rmse
#
# 散布図での比較
x_range <- range(c(lm_pred, tree_pred))
y_range <- range(df$shokenritsu)
plot(x_range, y_range, type = "n",
     xlab = "estimate", ylab = "actual",
     main = "Linear Model vs. Tree Model")
points(predict(lm_mod4v5), df$shokenritsu, pch = "L", col = "red")
points(tree_pred, df$shokenritsu, pch = "T", col = "blue")
abline(0, 1, col = "black")
legend("topleft", c("Linear Model", "Tree Model"),
       pch = c("L", "T"), col = c("red", "blue"), bty = "n")
#

(冒頭の画像は、Bing Image Creator で生成しました。プロンプトは、Natural landscape of white Jasmin flower fields, under the blue sky, there are so much flowers, Photo です。)

 

*1:lm_pred - df$shokenritsu)^2

*2:tree_pred - df$shokenritsu)^2))),
  Corr = c(cor(lm_pred, df$shokenritsu),
           cor(tree_pred, df$shokenritsu