【R模型】R语言随机森林分类进阶：交叉验证、调参与独立测试（保姆级教程）

随机森林并不难运行，难的是建立一套不会泄漏测试集信息、能够正确调参，并且可以解释最终结果的分类流程。本文使用真实信用风险数据，从数据检查开始，完整演示基线模型、五折交叉验证、参数调优、树数量稳定性、训练折外阈值选择、独立测试集评价以及置换变量重要性。

📋 文章目录

1. 本文解决什么问题
2. 随机森林的核心原理
3. 环境准备与数据审计
4. 训练集、测试集与交叉验证
5. 在 recipe 中完成预处理
6. 定义模型与参数空间
7. 默认模型基线与交叉验证调参
8. 1000 棵树是否合理
9. 在训练折外预测中选择分类阈值
10. 最终模型与独立测试集评价
11. ROC、PR 曲线与概率质量
12. 置换变量重要性及解释边界
13. 常见问题与解决方案
14. 完整可复用代码

---

🐣 一、本文解决什么问题

已有随机森林教程往往重点介绍两件事：怎样调用模型，以及怎样画变量重要性图。但在真正的分类项目中，更容易出错的是下面这些问题：

• 调参时能否反复查看测试集？
• 缺失值处理应该在交叉验证之前还是内部完成？
• mtry、min_n 和树的数量怎样确定？
• 准确率较高，为什么仍可能漏掉大量阳性样本？
• ROC AUC 和 PR AUC 应该怎样一起解释？
• 分类阈值应该用训练集还是测试集选择？
• 变量重要性高，是否表示变量会导致结果变化？

本文不是对已有"并行随机森林"或"随机森林重要性＋相关性热图"文章的重复。前者解决计算速度，后者解决生态回归结果的组合可视化；本文进一步解决的是二分类模型的验证、调参和独立评价。

完整的数据使用顺序如下：

原始数据
  ↓
分层划分训练集与测试集
  ↓
训练集内部建立五折交叉验证
  ↓
在每个折内学习预处理规则并调参
  ↓
利用训练折外预测选择分类阈值
  ↓
确定参数和阈值
  ↓
测试集只评价一次

测试集不是"第二个训练集"。如果我们看到测试结果后继续调整参数或阈值，测试集就已经参与模型开发，最终指标通常会过于乐观。

---

🐤 二、随机森林的核心原理

随机森林可以理解为由许多决策树组成的"评审团"。单棵树容易受训练样本影响，但大量具有差异的树共同投票，可以降低预测方差并提高稳定性。

1. Bootstrap 重采样

每棵树从训练数据中有放回地抽取样本。没有被某棵树抽到的记录称为袋外样本（out-of-bag，OOB），可以用来估计该森林的袋外误差。

2. 随机选择候选变量

每次节点分裂时，算法只从部分预测变量中寻找切分点，而不是同时检查所有变量。这一步由 mtry 控制，可以减少树与树之间的相关性。

分类树常用节点不纯度判断切分质量。以 Gini 不纯度为例：

Gini = 1 - Σ p(k)^2

其中 p(k) 是节点内第 k 类的比例。节点中的类别越混杂，Gini 越大；某次切分使两个子节点更"纯"，就能获得更大的不纯度下降。不过，本文使用的 permutation importance 并不直接把这种节点不纯度下降当作变量重要性。

3. 集成预测

分类森林汇总所有树的类别判断；概率森林汇总各棵树给出的类别概率。tidymodels 使用 ranger 处理分类任务时，默认拟合概率森林，因此既能输出类别，也能输出 .pred_bad 等类别概率。

假设森林共有 B 棵树，第 b 棵树给出 bad 类概率 p_b(x)，森林概率可以直观写成：

p̂(bad | x) = [p₁(x) + p₂(x) + ... + p_B(x)] / B

Bootstrap 让各棵树接触不同样本，随机候选变量让它们在分裂时看到不同信息。两种随机性共同降低树之间的相关性，使集成平均更稳定。

4. 三个重要参数

• mtry：每次节点分裂时随机考虑的预测变量数。
• min_n：节点继续分裂所需的最小样本数。较小的值通常产生更复杂的树。
• trees：森林中的树数量。树太少时结果可能不稳定；达到稳定区间后，继续增加只会提高计算成本，通常不会造成传统意义上的过拟合。

需要注意，"随机森林绝不会过拟合"是一种过度简化。数据泄漏、不合理验证、过度调参或训练数据缺乏代表性，仍然会让测试表现显著下降。

---

🐥 三、环境准备与数据审计

1. 安装和加载程序包

packages <- c("tidymodels", "ranger", "modeldata", "forcats")

new_packages <- packages[!packages %in% rownames(installed.packages())]
if (length(new_packages) > 0) {
  install.packages(new_packages)
}

library(tidymodels)
library(ranger)

本文的实跑版本如下：

R          4.6.0
tidymodels 1.5.0
ranger     0.18.0
modeldata  1.5.1
forcats    1.0.1

2. 数据背景与变量含义

本文使用 modeldata 包中的 credit_data。任务是根据申请人的工作、收入、资产及贷款信息，预测信用状态 Status。

data("credit_data", package = "modeldata")

credit_data <- credit_data |>
  mutate(Status = forcats::fct_relevel(Status, "bad"))

glimpse(credit_data)

数据共有 4,454 条记录和 14 个变量：

变量	类型	含义
Status	分类	信用状态：bad 或 good
Seniority	数值	工作年限
Home	分类	住房或居住类型
Time	数值	申请贷款期限
Age	数值	年龄
Marital	分类	婚姻状况
Records	分类	是否存在信用记录
Job	分类	工作类型
Expenses	数值	支出金额
Income	数值	收入金额
Assets	数值	资产金额
Debt	数值	债务金额
Amount	数值	申请贷款金额
Price	数值	所购商品价格

3. 类别比例

class_counts <- credit_data |>
  count(Status, name = "n") |>
  mutate(rate = n / sum(n))

class_counts

  Status    n   rate
1 bad    1254  0.282
2 good   3200  0.718

bad 占 28.2%，good 占 71.8%。这不是极端不平衡，但如果模型永远预测 good，准确率也能达到 71.8%。因此后面不能只看 accuracy。

本文把 bad 设为阳性事件，因为信用风险识别更关心"有多少不良客户被发现"。yardstick 默认把因子的第一个水平作为事件类别，所以应明确检查：

levels(credit_data$Status)
# [1] "bad"  "good"

4. 缺失值检查

missing_counts <- tibble(
  variable = names(credit_data),
  missing_n = vapply(credit_data, function(x) sum(is.na(x)), integer(1)),
  missing_rate = missing_n / nrow(credit_data)
)

missing_counts |>
  filter(missing_n > 0)

  variable missing_n missing_rate
1 Home             6       0.0013
2 Marital          1       0.0002
3 Job              2       0.0004
4 Income          381       0.0855
5 Assets           47       0.0106
6 Debt             18       0.0040

Income 的缺失率最高，约为 8.6%。直接删除所有缺失记录会损失信息，因此本文对数值变量使用训练数据中位数填补，对分类变量增加 unknown 水平。关键是：这些规则必须只从训练折学习。

---

🦆 四、训练集、测试集与交叉验证

1. 分层划分训练集和测试集

set.seed(20260801)

credit_split <- initial_split(
  credit_data,
  prop = 0.80,
  strata = Status
)

credit_train <- training(credit_split)
credit_test  <- testing(credit_split)

bind_rows(
  credit_train |> count(Status) |> mutate(dataset = "train"),
  credit_test  |> count(Status) |> mutate(dataset = "test")
)

  Status    n dataset
1 bad    1003 train
2 good   2560 train
3 bad     251 test
4 good    640 test

训练集共有 3,563 条记录，测试集共有 891 条记录。分层抽样使两部分的 bad 比例都保持在约 28.2%。

2. 只在训练集内部建立交叉验证

set.seed(20260801)

credit_folds <- vfold_cv(
  credit_train,
  v = 5,
  strata = Status
)

credit_folds

五折交叉验证会进行五轮训练：每轮使用其中四份建模，剩余一份验证。调参和阈值选择全部基于训练集内部产生的验证预测，测试集在最终步骤之前保持不可见。

如果数据具有时间、空间、医院、受试者或重复测量结构，普通随机五折可能不合适，应改用时间切分或分组重采样。

---

🦅 五、在 recipe 中完成预处理

credit_recipe <- recipe(Status ~ ., data = credit_train) |>
  # 分类变量缺失值转换为 unknown
  step_unknown(all_nominal_predictors()) |>
  # 保护模型免受新因子水平影响
  step_novel(all_nominal_predictors()) |>
  # 数值变量用训练数据中位数填补
  step_impute_median(all_numeric_predictors()) |>
  # 删除零方差预测变量
  step_zv(all_predictors())

credit_recipe

把预处理放入 recipe 后，每个交叉验证折都会独立估计填补值。假如先在全部数据上计算中位数，再建立交叉验证，验证折的信息就会提前进入训练过程。

随机森林按照变量切分点建树，一般不要求像 KNN 或 SVM 那样标准化数值变量；ranger 也能够直接处理因子预测变量，不需要手工创建哑变量。

---

🦉 六、定义模型与参数空间

1. 模型定义

rf_spec <- rand_forest(
  mtry  = tune(),
  min_n = tune(),
  trees = 1000
) |>
  set_engine(
    "ranger",
    importance = "permutation"
  ) |>
  set_mode("classification")

这里暂时把树数量固定为 1,000，并调节 mtry 和 min_n。第八节会利用 OOB Brier 分数检查 1,000 棵树是否已经进入稳定区间。

2. 建立 workflow

rf_workflow <- workflow() |>
  add_recipe(credit_recipe) |>
  add_model(rf_spec)

workflow 把预处理和模型封装为同一个对象，可以确保预测新数据时执行完全相同的步骤。

3. 生成空间填充参数网格

rf_params <- extract_parameter_set_dials(rf_workflow) |>
  finalize(credit_train |> select(-Status))

set.seed(20260801)
rf_grid <- grid_space_filling(
  rf_params,
  size = 20
)

rf_grid

mtry 的上限取决于预测变量数量，所以要先用训练集预测变量执行 finalize()。空间填充网格会尽量让 20 个候选点覆盖整个参数区域，比随意手写几组参数更均匀。

---

🦜 七、默认模型基线与交叉验证调参

1. 为什么先建立基线

调参后得到一个数字并不能说明调参是否有价值。先运行默认随机森林，可以回答：复杂的参数搜索究竟带来了多少提升？

default_rf_spec <- rand_forest(trees = 1000) |>
  set_engine("ranger", importance = "permutation") |>
  set_mode("classification")

default_rf_workflow <- workflow() |>
  add_recipe(credit_recipe) |>
  add_model(default_rf_spec)

set.seed(20260801)
default_resamples <- fit_resamples(
  default_rf_workflow,
  resamples = credit_folds,
  metrics = metric_set(roc_auc, pr_auc),
  control = control_resamples(event_level = "first")
)

collect_metrics(default_resamples)

  .metric  mean std_err
1 pr_auc  0.656  0.0123
2 roc_auc 0.830  0.0068

2. 定义调参评价指标

rf_metrics <- metric_set(
  roc_auc,
  pr_auc,
  accuracy,
  sens,
  spec
)

• ROC AUC：跨所有阈值的整体排序能力。
• PR AUC：精确率---召回率曲线下面积，对少数阳性类别更敏感。
• accuracy：所有记录中预测正确的比例。
• sensitivity：真实 bad 中被正确发现的比例。
• specificity：真实 good 中被正确排除的比例。

3. 执行五折网格调参

set.seed(20260801)

rf_tune <- tune_grid(
  rf_workflow,
  resamples = credit_folds,
  grid = rf_grid,
  metrics = rf_metrics,
  control = control_grid(
    save_pred = TRUE,
    event_level = "first"
  )
)

save_pred = TRUE 会保存每个验证折的折外预测，后面可以在不接触测试集的前提下选择分类阈值。

4. 选择最优参数

best_rf <- select_best(
  rf_tune,
  metric = "roc_auc"
)

best_rf

  mtry min_n
1    2    34

最优组合的五折平均指标如下：

  metric    mean std_err
1 accuracy 0.788  0.0060
2 pr_auc   0.662  0.0125
3 roc_auc  0.833  0.0070
4 sens     0.405  0.0169
5 spec     0.938  0.0057

与默认模型相比，调参后的 ROC AUC 从 0.830 增加到 0.833，PR AUC 从 0.656 增加到 0.662，提升并不大。这是一个很重要的结果：调参不是保证大幅提升性能的魔法，本数据中的主要矛盾其实是默认分类阈值偏向多数类别。

同时，ROC AUC 的折间标准误约为 0.007，参数组合之间仅有千分位差异时，不应把排行榜第一名解释为压倒性优势。

---

🐧 八、1000 棵树是否合理

只说"树越多越稳定"还不够。我们使用最优 mtry 和 min_n，分别拟合 100、250、500、750、1,000 和 1,500 棵树，并记录概率森林的 OOB Brier 分数。

tree_counts <- c(100, 250, 500, 750, 1000, 1500)

# 使用与最终 workflow 相同的预处理规则
prepared_credit_recipe <- prep(
  credit_recipe,
  training = credit_train
)
credit_train_processed <- bake(
  prepared_credit_recipe,
  new_data = NULL
)

tree_stability <- purrr::map_dfr(
  tree_counts,
  function(tree_count) {
    model <- ranger(
      Status ~ .,
      data = credit_train_processed,
      num.trees = tree_count,
      mtry = best_rf$mtry,
      min.node.size = best_rf$min_n,
      probability = TRUE,
      num.threads = 2,
      seed = 20260801
    )

    tibble(
      trees = tree_count,
      oob_brier = model$prediction.error
    )
  }
)

tree_stability

  trees oob_brier
1   100   0.14630
2   250   0.14556
3   500   0.14543
4   750   0.14534
5  1000   0.14523
6  1500   0.14513

Brier 分数越低越好。100 棵增加到 250 棵时下降较明显，之后曲线趋于平缓；从 1,000 增加到 1,500 只下降约 0.00010。因而，1,000 棵树在本数据中是计算成本和稳定性的合理折中，并不是凭经验随意指定。

OOB 结果只用于检查树数量稳定性，最终泛化性能仍然以独立测试集为准。

---

🕊️ 九、在训练折外预测中选择分类阈值

1. 为什么默认 0.5 不一定合适

概率高于 0.5 就判为 bad，只是一个默认规则，并不一定符合任务目标。五折结果中 sensitivity 只有 0.405，而 specificity 达到 0.938，说明默认阈值更倾向把申请人判为 good。

本例没有提供误放贷款和误拒贷款的真实成本，因此使用 balanced accuracy 作为演示目标，使敏感度与特异度获得同等权重。真实业务应优先使用成本函数或预先规定的最低敏感度。

2. 提取最优参数的训练折外预测

oof_predictions <- collect_predictions(
  rf_tune,
  parameters = best_rf
)

3. 扫描候选阈值

threshold_metrics <- purrr::map_dfr(
  seq(0.10, 0.90, by = 0.01),
  function(threshold) {
    estimate <- factor(
      if_else(oof_predictions$.pred_bad >= threshold, "bad", "good"),
      levels = levels(oof_predictions$Status)
    )

    tibble(
      threshold = threshold,
      sensitivity = sens_vec(
        oof_predictions$Status,
        estimate,
        event_level = "first"
      ),
      specificity = spec_vec(
        oof_predictions$Status,
        estimate,
        event_level = "first"
      ),
      precision = ppv_vec(
        oof_predictions$Status,
        estimate,
        event_level = "first"
      ),
      balanced_accuracy = bal_accuracy_vec(
        oof_predictions$Status,
        estimate,
        event_level = "first"
      )
    )
  }
)

best_threshold <- threshold_metrics |>
  arrange(desc(balanced_accuracy), desc(sensitivity)) |>
  slice(1)

best_threshold

  threshold sensitivity specificity precision balanced_accuracy
1      0.31       0.766       0.750     0.545             0.758

最终阈值为 0.31。这意味着预测不良信用概率达到 31% 时，就将申请人标记为 bad。降低阈值会发现更多风险客户，但也会增加对正常客户的误报。

最重要的原则是：0.31 来自训练集折外预测，而不是查看测试集后反复尝试得到的。

---

🦢 十、最终模型与独立测试集评价

1. 固化最优参数并进行最后一次拟合

final_rf_workflow <- finalize_workflow(
  rf_workflow,
  best_rf
)

set.seed(20260801)
rf_last_fit <- last_fit(
  final_rf_workflow,
  split = credit_split,
  metrics = rf_metrics,
  control = control_last_fit(
    event_level = "first"
  )
)

last_fit() 使用完整训练集重新拟合已经确定的 workflow，然后只在测试集上评价一次。

2. 同时比较默认阈值和训练期阈值

rf_predictions <- collect_predictions(rf_last_fit) |>
  mutate(
    .pred_threshold = factor(
      if_else(.pred_bad >= 0.31, "bad", "good"),
      levels = levels(Status)
    )
  )

测试集结果如下：

阈值规则	accuracy	sensitivity	specificity	precision	F1	balanced accuracy
默认 0.50	0.793	0.450	0.928	0.711	0.551	0.689
训练期选择 0.31	0.771	0.773	0.770	0.569	0.655	0.772

把阈值从 0.50 降到 0.31 后：

• sensitivity 从 45.0% 上升到 77.3%，提高 32.3 个百分点；
• specificity 从 92.8% 下降到 77.0%；
• precision 从 71.1% 下降到 56.9%；
• accuracy 小幅下降 2.2 个百分点；
• balanced accuracy 从 68.9% 上升到 77.2%。

这说明阈值选择不是让所有指标同时变好，而是在漏判风险和误报正常客户之间做取舍。

3. 混淆矩阵

默认 0.50 阈值：

          Truth
Prediction bad good
      bad  113   46
      good 138  594

训练期选择的 0.31 阈值：

          Truth
Prediction bad good
      bad  194  147
      good  57  493

在 251 个真实 bad 客户中，默认阈值只发现 113 个，漏掉 138 个；使用 0.31 后发现 194 个，只漏掉 57 个。代价是把 147 个真实 good 客户误报为风险客户。

哪种阈值更好，最终取决于漏判一个风险客户和误报一个正常客户各自造成多大损失。本文的 0.31 是统计演示值，不是可以直接照搬到所有信用业务的固定标准。

---

🦩 十一、ROC、PR 曲线与概率质量

1. 测试集概率指标

tibble(
  roc_auc = roc_auc_vec(
    rf_predictions$Status,
    rf_predictions$.pred_bad,
    event_level = "first"
  ),
  pr_auc = pr_auc_vec(
    rf_predictions$Status,
    rf_predictions$.pred_bad,
    event_level = "first"
  ),
  brier = brier_class_vec(
    rf_predictions$Status,
    rf_predictions$.pred_bad,
    event_level = "first"
  )
)

  roc_auc pr_auc brier
1   0.847  0.686 0.140

2. ROC 曲线

rf_roc <- roc_curve(
  rf_predictions,
  truth = Status,
  .pred_bad,
  event_level = "first"
)

autoplot(rf_roc)

测试集 ROC AUC 为 0.847，表示随机抽取一名 bad 和一名 good 客户时，模型把 bad 客户排在更高风险位置的概率约为 84.7%。AUC 衡量排序能力，不直接决定业务阈值。

3. PR 曲线

rf_pr <- pr_curve(
  rf_predictions,
  truth = Status,
  .pred_bad,
  event_level = "first"
)

autoplot(rf_pr)

测试集 bad 比例为 0.282，所以随机排序的 PR 基线约为 0.282；模型 PR AUC 为 0.686，明显高于该基线。PR AUC 必须结合阳性率解释，不宜在类别比例不同的数据集之间直接横向比较。

Brier 分数为 0.140，它衡量预测概率与真实结果之间的平均平方误差，越低越好。不过一个 Brier 数字不能代替完整校准分析；如果业务需要把概率解释为真实违约概率，还应进一步绘制校准曲线并进行外部验证。

---

🦚 十二、置换变量重要性及解释边界

1. 提取最终模型

final_rf_engine <- rf_last_fit |>
  extract_workflow() |>
  extract_fit_engine()

importance_data <- tibble::enframe(
  final_rf_engine$variable.importance,
  name = "variable",
  value = "importance"
) |>
  arrange(desc(importance))

importance_data

   variable  importance
1  Records      0.0199
2  Seniority    0.0182
3  Job          0.0145
4  Income       0.0135
5  Amount       0.0134
6  Assets       0.0117
7  Home         0.0076
8  Price        0.0056
9  Age          0.0047
10 Expenses     0.0046
11 Time         0.0039
12 Marital      0.0016
13 Debt         0.0010

Records、Seniority、Job、Income 和 Amount 对当前模型的预测贡献最高。置换重要性通过打乱变量并观察预测性能下降来衡量贡献，通常比直接累加节点纯度下降更适合比较预测信息。

2. 三个不能越过的解释边界

变量重要性不能直接回答：

• 变量增大时，风险上升还是下降；
• 改变变量是否会导致信用状态改变；
• 变量是否具有独立因果效应。

当多个变量高度相关时，它们可能共享或替代彼此的预测信息，重要性会被分摊。若要研究影响方向和非线性关系，可以进一步使用部分依赖图或累积局部效应图；若要回答因果问题，则需要另外的研究设计与假设。

本图的重要性来自训练完整森林的 OOB 置换过程，并不是测试集上的因果证据或显著性检验。

---

🐓 十三、常见问题与解决方案

问题 1：代码提示没有 forcats 包

虽然代码使用了 forcats:: 命名空间，但 forcats 不一定随当前 tidymodels 安装自动提供。请明确安装：

install.packages("forcats")

问题 2：enframe() 找不到

enframe() 来自 tibble。为了避免依赖搜索路径，应写成：

tibble::enframe(final_rf_engine$variable.importance)

问题 3：准确率较高，却几乎识别不出 bad

这是类别不平衡和默认阈值共同造成的典型现象。请同时查看 sensitivity、PR AUC、balanced accuracy 和混淆矩阵，并在训练重采样预测中选择阈值。

问题 4：能否根据测试集结果调整阈值

不能。测试集用于最终评价，不用于选择参数、变量或阈值。阈值应来自训练折外预测，或者来自单独的验证集。

问题 5：ROC AUC 与 PR AUC 趋势不同

ROC AUC 衡量两类样本的整体排序；PR AUC 更直接关注阳性预测的精确率和召回率，并受阳性率影响。阳性事件较少时，PR AUC 通常更能揭示实际识别难度。

问题 6：出现新的因子水平报错

把 step_novel(all_nominal_predictors()) 放入 recipe，使训练阶段未见过的新水平得到统一处理。

问题 7：mtry 超出预测变量数量

先根据训练集预测变量完成参数范围：

rf_params <- extract_parameter_set_dials(rf_workflow) |>
  finalize(credit_train |> select(-Status))

问题 8：变量重要性出现负值

打乱某个变量后，模型可能因为随机波动而略微变好，从而产生负的重要性。这通常说明该变量没有稳定的预测贡献，不表示变量具有"负向影响"。

问题 9：换一批数据后性能明显下降

需要依次检查：

• 测试集是否曾被用于调参或选阈值；
• 新数据的类别比例是否改变；
• 变量含义、测量方式或缺失机制是否改变；
• 是否存在时间、空间或群组结构；
• 模型是否只在一个随机切分上表现良好。

内部交叉验证不能替代真正的外部验证。

---

📚 十四、完整可复用代码

下面代码可以直接作为二分类随机森林项目的起点。替换数据、结果变量和阳性类别后，还要根据业务目标重新确定指标和阈值。

library(tidymodels)
library(ranger)

# 1. 数据 ---------------------------------------------------------------
data("credit_data", package = "modeldata")

credit_data <- credit_data |>
  mutate(Status = forcats::fct_relevel(Status, "bad"))

# 类别与缺失值检查
credit_data |> count(Status) |> mutate(rate = n / sum(n))

tibble(
  variable = names(credit_data),
  missing_n = vapply(credit_data, function(x) sum(is.na(x)), integer(1))
)

# 2. 训练/测试划分 ------------------------------------------------------
set.seed(20260801)
credit_split <- initial_split(credit_data, prop = 0.80, strata = Status)
credit_train <- training(credit_split)
credit_test  <- testing(credit_split)

# 3. 五折交叉验证 -------------------------------------------------------
set.seed(20260801)
credit_folds <- vfold_cv(credit_train, v = 5, strata = Status)

# 4. 预处理 -------------------------------------------------------------
credit_recipe <- recipe(Status ~ ., data = credit_train) |>
  step_unknown(all_nominal_predictors()) |>
  step_novel(all_nominal_predictors()) |>
  step_impute_median(all_numeric_predictors()) |>
  step_zv(all_predictors())

# 5. 随机森林 -----------------------------------------------------------
rf_spec <- rand_forest(
  mtry = tune(),
  min_n = tune(),
  trees = 1000
) |>
  set_engine("ranger", importance = "permutation") |>
  set_mode("classification")

rf_workflow <- workflow() |>
  add_recipe(credit_recipe) |>
  add_model(rf_spec)

# 6. 参数网格 -----------------------------------------------------------
rf_params <- extract_parameter_set_dials(rf_workflow) |>
  finalize(credit_train |> select(-Status))

set.seed(20260801)
rf_grid <- grid_space_filling(rf_params, size = 20)

# 7. 五折调参 -----------------------------------------------------------
rf_metrics <- metric_set(roc_auc, pr_auc, accuracy, sens, spec)

set.seed(20260801)
rf_tune <- tune_grid(
  rf_workflow,
  resamples = credit_folds,
  grid = rf_grid,
  metrics = rf_metrics,
  control = control_grid(save_pred = TRUE, event_level = "first")
)

best_rf <- select_best(rf_tune, metric = "roc_auc")
best_rf

# 8. 训练折外阈值 -------------------------------------------------------
oof_predictions <- collect_predictions(rf_tune, parameters = best_rf)

threshold_metrics <- purrr::map_dfr(
  seq(0.10, 0.90, by = 0.01),
  function(threshold) {
    estimate <- factor(
      if_else(oof_predictions$.pred_bad >= threshold, "bad", "good"),
      levels = levels(oof_predictions$Status)
    )

    tibble(
      threshold = threshold,
      sensitivity = sens_vec(
        oof_predictions$Status,
        estimate,
        event_level = "first"
      ),
      specificity = spec_vec(
        oof_predictions$Status,
        estimate,
        event_level = "first"
      ),
      balanced_accuracy = bal_accuracy_vec(
        oof_predictions$Status,
        estimate,
        event_level = "first"
      )
    )
  }
)

best_threshold <- threshold_metrics |>
  arrange(desc(balanced_accuracy), desc(sensitivity)) |>
  slice(1)

best_threshold

# 9. 最终模型和测试集 ---------------------------------------------------
final_rf_workflow <- finalize_workflow(rf_workflow, best_rf)

set.seed(20260801)
rf_last_fit <- last_fit(
  final_rf_workflow,
  split = credit_split,
  metrics = rf_metrics,
  control = control_last_fit(event_level = "first")
)

rf_predictions <- collect_predictions(rf_last_fit) |>
  mutate(
    .pred_threshold = factor(
      if_else(
        .pred_bad >= best_threshold$threshold,
        "bad",
        "good"
      ),
      levels = levels(Status)
    )
  )

# 阈值无关指标
roc_auc(rf_predictions, truth = Status, .pred_bad, event_level = "first")
pr_auc(rf_predictions, truth = Status, .pred_bad, event_level = "first")

# 训练期阈值对应的混淆矩阵
conf_mat(
  rf_predictions,
  truth = Status,
  estimate = .pred_threshold
)

# 10. 变量重要性 --------------------------------------------------------
final_rf_engine <- rf_last_fit |>
  extract_workflow() |>
  extract_fit_engine()

importance_data <- tibble::enframe(
  final_rf_engine$variable.importance,
  name = "variable",
  value = "importance"
) |>
  arrange(desc(importance))

importance_data

---

✅ 总结

本文得到的不是一行随机森林代码，而是一套可以迁移到其他二分类任务的验证逻辑：

1. 先明确阳性类别并检查类别比例、缺失值和变量含义；
2. 分层划分训练集和测试集，测试集保持不可见；
3. 在训练集内部完成预处理、交叉验证和参数选择；
4. 与默认模型比较，判断调参是否产生实质收益；
5. 用 OOB 误差检查树数量是否进入稳定区间；
6. 从训练折外预测选择阈值，不使用测试集调阈值；
7. 同时报告 ROC AUC、PR AUC、敏感度、特异度和混淆矩阵；
8. 把变量重要性解释为预测贡献，而不是影响方向或因果效应。

在本案例中，最优参数为 mtry = 2、min_n = 34。调参对排序能力的改善较小，而把阈值从 0.50 调整为训练期选择的 0.31，使测试集 sensitivity 从 45.0% 提高到 77.3%。这也说明，在很多分类任务中，正确的验证顺序和阈值决策，可能比追求参数排行榜第一名更重要。

参考资料

• modeldata：credit_data 数据说明
• parsnip：ranger 随机森林引擎
• tune：网格调参
• tune：最终模型测试
• tune：控制事件类别
• yardstick：ROC AUC
• yardstick：PR AUC
• dials：空间填充参数网格
• recipes：零方差变量处理