如何用Yardstick计算分组预测聚合值的RMSE？

我不想评估模型对单个观测的预测性能，而是希望评估模型在分组聚合预测上的表现。rsample中的分组重采样工具（如group_vfold_cv）能确保数据拆分时分组保持完整，但我需要基于分组性能而非单个观测性能评估模型。

比如用Ames数据集预测单户房价，最终目的是估算整个社区的房产总价值。我不想基于单户预测性能调优模型，而是要基于社区房价总和的预测性能来调优（假设数据集包含每个社区的完整数据）。

现有代码能评估单户预测的RMSE，但需要改成评估社区总价值预测的RMSE，现有代码如下：

# Load in data and transform Neighborhood variable a little
library(tidymodels)
df <- ames
df <- recipe(Sale_Price ~ ., data = df) %>% 
  step_other(Neighborhood, threshold = .04) %>% 
  prep() %>% 
  bake(new_data = df)

# Split data based off neighborhoods
set.seed(1)
df_splits <- group_initial_split(df, group = Neighborhood)
df_train <- training(df_splits)
df_test <- testing(df_splits)
set.seed(2)
df_folds <- group_vfold_cv(df_train, group = Neighborhood, v = 5, repeats = 1)

# Simple recipe for modeling Sale_Price
rec <- recipe(Sale_Price ~ Lot_Area + Year_Built + Gr_Liv_Area, data = df_train)

# Setting up specification for MARS and RF
mars_earth_spec <-
  mars(prod_degree = tune()) %>%
  set_engine('earth') %>%
  set_mode('regression')
rand_forest_ranger_spec <-
  rand_forest(mtry = tune(), min_n = tune()) %>%
  set_engine('ranger') %>%
  set_mode('regression')

# Setting up the workflow that pairs our recipe with models
no_pre_proc <- 
  workflow_set(
    preproc = list(simple = rec), 
    models = list(MARS = mars_earth_spec, RF = rand_forest_ranger_spec)
  )

# Tune the models
grid_ctrl <-
  control_grid(
    save_pred = TRUE,
    parallel_over = "everything",
    save_workflow = TRUE
  )
grid_results <-
  no_pre_proc %>%
  workflow_map(
    seed = 1503,
    resamples = df_folds,
    grid = 5,
    control = grid_ctrl
  )

# Ranking the models by RMSE for models based off their performance estimating individual houses
grid_results %>% 
  rank_results() %>% 
  filter(.metric == "rmse") %>% 
  select(model, .config, rmse = mean, rank)
# This is not what I want
# I want to rank the models by RMSE of aggregate predictions per neighborhood against the aggregate sale price
# Maybe I need something like... Truth = sum(Sale_Price, by = Neighborhood), estimate = sum(.pred, by Neighborhood)

要实现基于分组聚合的性能评估，需要自定义一个聚合RMSE指标函数，并在模型调参过程中使用这个指标替代默认的单观测RMSE。具体步骤如下：

1. 自定义分组聚合RMSE指标函数 #

这个函数会先按分组（Neighborhood）聚合真实值和预测值的总和，再计算聚合后的RMSE：

# 自定义分组聚合RMSE指标
group_rmse <- function(data, truth, estimate, group, na_rm = TRUE, ...) {
  truth_expr <- rlang::enquo(truth)
  estimate_expr <- rlang::enquo(estimate)
  group_expr <- rlang::enquo(group)
  
  data %>%
    dplyr::group_by(!!group_expr) %>%
    dplyr::summarize(
      truth_sum = sum(!!truth_expr, na.rm = na_rm),
      estimate_sum = sum(!!estimate_expr, na.rm = na_rm),
      .groups = "drop"
    ) %>%
    yardstick::rmse(truth = truth_sum, estimate = estimate_sum, na_rm = na_rm, ...)
}

# 注册自定义指标，让tidymodels识别
group_rmse_vec <- function(truth, estimate, group, na_rm = TRUE, ...) {
  tibble::tibble(truth, estimate, group) %>%
    group_rmse(truth = truth, estimate = estimate, group = group, na_rm = na_rm, ...) %>%
    dplyr::pull(.estimate)
}

yardstick::metric_summarizer(
  metric_nm = "group_rmse",
  metric_fn = group_rmse_vec,
  direction = "minimize",
  type = "numeric"
)

2. 在调参时指定使用自定义指标 #

修改workflow_map的调用，加入metrics参数指定使用我们的group_rmse：

# 重新运行调参，使用自定义聚合RMSE指标
grid_results_group <-
  no_pre_proc %>%
  workflow_map(
    seed = 1503,
    resamples = df_folds,
    grid = 5,
    control = grid_ctrl,
    metrics = yardstick::metric_set(group_rmse) # 指定自定义指标
  )

3. 查看基于聚合结果的模型排名 #

现在就可以按社区总价值预测的RMSE来排序模型了：

grid_results_group %>% 
  rank_results() %>% 
  filter(.metric == "group_rmse") %>% 
  select(model, .config, group_rmse = mean, rank)

补充：验证测试集的聚合性能 #

如果要在测试集上验证最终模型的聚合性能，可以用同样的逻辑处理测试集预测结果：

# 选择最优模型（比如RF的最优配置）
best_rf <- grid_results_group %>%
  extract_workflow_set_result("simple_RF") %>%
  select_best(metric = "group_rmse")

# 拟合最优模型到训练集
final_rf <- grid_results_group %>%
  extract_workflow("simple_RF") %>%
  finalize_workflow(best_rf) %>%
  fit(data = df_train)

# 预测测试集并计算聚合RMSE
test_pred <- final_rf %>%
  predict(df_test) %>%
  bind_cols(df_test %>% select(Sale_Price, Neighborhood))

group_rmse(test_pred, truth = Sale_Price, estimate = .pred, group = Neighborhood)

内容的提问来源于stack exchange，提问作者Econ_Modeler