【R语言】基于多模型的变量重要性图 (Variable Importance Plots) ...

1. 写在前面

  好久没有更新博客了，正好最近在帮老师做一个项目，内里涉及到了不同环境变量的重要性制图，所以在这里把我的明白举行分享，这应该是大家都大概遇到的标题。笔者程度有限，大家发现什么标题可以给我指出。
  变量重要度图(Variable importance plots) 可以非常直观的展示各个变量在模型中的重要度，从而可以更好的明白和解释所建立的模型。
2.1数据导入

  这里我随机生成了一个数据集，包含了10个x变量

1. ## 基于树模型的变量重要度图(Variable Importance Plots)-------------------------
2. library(vip) # 制作变量重要度图
3. library(rpart) # 决策树
4. library(randomForest) # 随机森林
5. library(xgboost) # 梯度提升决策树
6. library(mgcv)
7. library(caret)
8. library(ggplot2) # 作图
10. mydata <- gen_friedman( # 创建数据
11.   n_samples = 100, # 行数
12.   sigma = 1,       # 标准差
13.   seed = 123       # 让数据可以重复
14. )
15. nrow(mydata)
16. head(mydata)

复制代码

数据集结构：

2.2 模型训练

  这里包括了四个模型：决策树(Decision trees)、随机森林(Random forests)、梯度提拔决策树(GBMs)、广义可加模型（GAM）

1. # 1、拟合回归决策树模型-------------------------------------------
2. model_tree <- rpart(y ~ ., data = mydata)
4. # 2、拟合随机森林模型---------------------------------------------
5. model_rf <- randomForest(y ~ .,
6.                          data = mydata,
7.                          importance = TRUE)  # 计算变量的重要度   
9. # 3、拟合梯度提升决策树模型(GBMs)---------------------------------
10. model_gbm <- xgboost(
11.   data = data.matrix(subset(mydata, select = -y)), # 剔除y后将数据转化为矩阵格式
12.   label = mydata$y, # 指定因变量y
13.   nrounds = 100, # 提升迭代的最大次数
14.   max_depth = 5, # 树的最大深度为5，默认为6
15.   verbose = 0  # 不输出模型的运行信息
16. )
18. # 4、拟合广义可加模型 (GAM)----------------------------------------
19. # 自动创建公式字符串：将所有自变量包裹在平滑函数 s() 中
20. gam_formula <- as.formula(paste("y ~", paste0("s(", names(mydata)[-1], ")"
21.                                               , collapse = " + ")))
22. model_gam <- gam(gam_formula, data = mydata)
23. # # 拟合广义可加模型 (GAM)
24. # model_gam <- gam(y ~ s(x1) + s(x2) + s(x3) + s(x4) + s(x5)
25. #                  + s(x6) + s(x7) + s(x8) + s(x9) + s(x10),
26. #                  data = mydata)

复制代码

2.3 变量重要性

  利用vi()函数可以得到不同模型模拟的变量的重要性值

1. # 决策树
2. vi(model_tree)
3. # 随机森林
4. vi(model_rf)
5. # GBMs
6. vi(model_gbm)
7. # 计算GAM模型的变量重要度
8. vi_gam <- vi(model_gam, method = "permute", target = "y",
9.              metric = "rmse", pred_wrapper = predict)

复制代码

简朴列出其中一个模型的结果：

2.4 变量重要性图

  这大概是大家最关心的地方

1. # 制作变量重要度图
2. p1 <- vip(model_tree) + ggtitle("Single tree")
3. p2 <- vip(model_rf) + ggtitle("Random forest")
4. p3 <- vip(model_gbm) + ggtitle("Gradient boosting")
5. p4 <- vip(vi_gam) + ggtitle("GAM (Generalized Additive Model)")
7. # 将图片合并成1行3列
8. grid.arrange(p1, p2, p3, p4, nrow = 2)

复制代码

结果展示：

可以看出，不同模型模拟的结果根本上是一致的。
2.5 模型模拟验证

  这里用到了三个指标：R2、MAE和RMSE，详细公式如下，这里我没有利用Adjusted R2：

1. ## 模型模拟效果----------------------------------------------------------------
2. # 定义计算 R2的函数
3. calc_r2 <- function(actual, predicted) {
4.   ss_res <- sum((actual - predicted) ^ 2)
5.   ss_tot <- sum((actual - mean(actual)) ^ 2)
6.   1 - (ss_res / ss_tot)
7. }
9. # 定义计算 MAE 的函数
10. calc_mae <- function(actual, predicted) {
11.   mean(abs(actual - predicted))
12. }
14. # 定义计算 RMSE 的函数
15. calc_rmse <- function(actual, predicted) {
16.   sqrt(mean((actual - predicted) ^ 2))
17. }
19. # 获取实际值
20. actual_values <- mydata$y
22. # 计算每个模型的预测值
23. pred_tree <- predict(model_tree, mydata)
24. pred_rf <- predict(model_rf, mydata)
25. pred_gbm <- predict(model_gbm, data.matrix(subset(mydata, select = -y)))
26. pred_gam <- predict(model_gam, mydata)
28. # 计算 R2
29. r2_tree <- calc_r2(actual_values, pred_tree)
30. r2_rf <- calc_r2(actual_values, pred_rf)
31. r2_gbm <- calc_r2(actual_values, pred_gbm)
32. r2_gam <- calc_r2(actual_values, pred_gam)
34. # 计算 MAE
35. mae_tree <- calc_mae(actual_values, pred_tree)
36. mae_rf <- calc_mae(actual_values, pred_rf)
37. mae_gbm <- calc_mae(actual_values, pred_gbm)
38. mae_gam <- calc_mae(actual_values, pred_gam)
40. # 计算 RMSE
41. rmse_tree <- calc_rmse(actual_values, pred_tree)
42. rmse_rf <- calc_rmse(actual_values, pred_rf)
43. rmse_gbm <- calc_rmse(actual_values, pred_gbm)
44. rmse_gam <- calc_rmse(actual_values, pred_gam)
46. # 输出结果
47. cat(
48.   "Decision Tree:               R2 =", r2_tree,  "MAE =", mae_tree, "RMSE =", rmse_tree, "\n",
49.   "Random Forest:              R2 =", r2_rf,  "MAE =", mae_rf, "RMSE =", rmse_rf, "\n",
50.   "Gradient Boosting:          R2 =", r2_gbm,  "MAE =", mae_gbm, "RMSE =", rmse_gbm, "\n",
51.   "Generalized Additive Model: R2 =", r2_gam,  "MAE =", mae_gam, "RMSE =", rmse_gam, "\n"
52. )

复制代码

结果展示：

3.基于caret包盘算变量重要性

  以上内容没有涉及到交织验证，并且所有的模型评价指标都是手动盘算的，现在我将利用caret包提供的函数举行盘算。
  caret（Classification and Regression Ensemble Training）包 是 R 语言中一个非常强大的工具，用于分类和回归模型的训练和评估。它提供了一个同一的接口来实现不同的机器学习算法，并支持模型的调参、训练、预测和评估。
主要功能和特点

• 同一的接口 : caret 提供了一个同一的接口来训练和评估各种机器学习模型，无论是分类模型还是回归模型。如许，你可以在不同的算法之间举行比较和选择。
  
• 模型训练 : 利用 train() 函数可以训练模型，支持多种模型算法，如决策树、随机森林、支持向量机（SVM）、梯度提拔、线性回归、广义可加模型（GAM）等。
  
• 调参（Tuning）: caret 答应你通过网格搜索（grid search）和随机搜索（random search）来调治模型的超参数，以找到最佳的参数组合。利用 train() 函数时，可以通过 tuneGrid 或 tuneLength 参数来指定需要调治的参数范围。
  
• 交织验证（Cross-Validation）: 提供了多种交织验证方法，如 k 折交织验证（k-fold cross-validation）来评估模型的性能。你可以通过 trainControl() 函数设置交织验证的参数。
  
• 性能评估 : caret 可以盘算模型的性能指标，如正确率（accuracy）、均方根偏差（RMSE）、均方偏差（MSE）、调整后的 R²（Adjusted R²）等。可以通过 postResample() 函数来提取模型的性能度量。
  
• 数据预处理 : 支持数据预处理操纵，如数据标准化（standardization）、归一化（normalization）、特性选择（feature selection）等。这些操纵可以通过 preProcess() 函数实现。
  
• 模型集成 : 支持多种模型集成方法，如堆叠（stacking）和集成（ensembling），以提高模型的预测性能。
  

1. ## caret ----------------------------------------------------------------------
2. # Set up 10-fold cross-validation
3. train_control <- trainControl(method = "cv", number = 10)
5. # glm with 10-fold cross-validation
6. model_glm_cv <- train(
7.   y ~ .,
8.   data = mydata,
9.   method = "glm",
10.   trControl = train_control,
11.   metric = "RMSE"
12. )
14. # GAM with 10-fold cross-validation
15. model_gam_cv <- train(
16.   y ~ .,
17.   data = mydata,
18.   method = "gamSpline",
19.   trControl = train_control,
20.   metric = "RMSE"
21. )
23. # Random Forest with 10-fold cross-validation
24. model_rf_cv <- train(
25.   y ~ .,
26.   data = mydata,
27.   method = "rf",
28.   trControl = train_control,
29.   metric = "RMSE"
30. )
32. # Gradient Boosting with 10-fold cross-validation
33. model_gbm_cv <- train(
34.   y ~ .,
35.   data = mydata,
36.   method = "xgbTree",
37.   trControl = train_control,
38.   metric = "RMSE"
39. )
41. # 计算并绘制变量重要性
42. vip(model_glm_cv)
43. vip(model_gam_cv)
44. vip(model_rf_cv)
45. vip(model_gbm_cv)
47. # make Variable Importance Plots
48. p11 <- vip(model_glm_cv) + ggtitle("Generalized linear Model")
49. p21 <- vip(model_gam_cv) + ggtitle("Random forest")
50. p31 <- vip(model_rf_cv) + ggtitle("Gradient boosting")
51. p41 <- vip(model_gbm_cv) + ggtitle("Generalized Additive Model")
53. grid.arrange(p11, p21, p31, p41, nrow = 2)
55. # Extract the results
56. results_glm <- model_glm_cv$results
57. results_rf <- model_rf_cv$results
58. results_gbm <- model_gbm_cv$results
59. results_gam <- model_gam_cv$results
61. # Print results
62. cat(
63.   "Generalized linear Model (GLM):   R2 =", max(results_glm$Rsquared), "MAE =", min(results_tree$MAE), "RMSE =", min(results_tree$RMSE), "\n",
64.   "Random Forest (RF):              R2 =", max(results_rf$Rsquared), "MAE =", min(results_rf$MAE), "RMSE =", min(results_rf$RMSE), "\n",
65.   "Gradient Boosting (GBM):         R2 =", max(results_gbm$Rsquared), "MAE =", min(results_gbm$MAE), "RMSE =", min(results_gbm$RMSE), "\n",
66.   "Generalized Additive Model(GAM): R2 =", max(results_gam$Rsquared), "MAE =", min(results_gam$MAE), "RMSE =", min(results_gam$RMSE), "\n"
67. )

复制代码

结果展示：

模型模拟精度验证：

免责声明：如果侵犯了您的权益，请联系站长，我们会及时删除侵权内容，谢谢合作！更多信息从访问主页：qidao123.com:ToB企服之家，中国第一个企服评测及商务社交产业平台。