基于分组数据的LM模型：移除负系数变量重跑模型问题

我懂你现在卡在哪了——已经搞定了分组拟合，但不知道怎么针对那些有负系数的分组，自动去掉对应的变量重新跑模型对吧？别着急，我们可以用dplyr的嵌套数据框加上purrr的映射功能，再配合动态构建公式的技巧来解决这个问题，一步步来：

1. 先准备可复现的虚拟数据集（和你的需求匹配） #

先造一个和你描述一致的测试数据，方便我们验证效果：

set.seed(123) # 固定随机种子，结果可复现
test_coef <- tibble(
  Grouping = rep(c("StateA", "StateB", "StateC"), each = 50),
  years = rnorm(150, 10, 3),
  months = rnorm(150, 50, 10),
  rate = case_when(
    Grouping == "StateA" ~ 2 + 1.5*years - 0.2*months + rnorm(50, 0, 1), # months系数为负
    Grouping == "StateB" ~ 1 - 0.3*years + 0.8*months + rnorm(50, 0, 1), # years系数为负
    Grouping == "StateC" ~ 0.5 + 0.7*years + 0.4*months + rnorm(50, 0, 1) # 两个系数都正
  )
)

2. 拟合初始模型并筛选需要保留的变量 #

这里我们用nest()来处理分组数据（比do()更符合新版dplyr的风格），然后提取系数，筛选出每个分组里系数为正的自变量（注意：截距项的正负我们不用管，只处理自变量）：

library(dplyr)
library(broom)
library(purrr)

# 第一步：拟合初始分组模型，把数据和模型嵌套起来
initial_models <- test_coef %>%
  group_by(Grouping) %>%
  nest() %>%
  mutate(model = map(data, ~lm(rate ~ years + months, data = .x)))

# 第二步：提取系数，筛选每个分组要保留的正系数自变量
coef_summary <- initial_models %>%
  mutate(coefs = map(model, tidy)) %>%
  unnest(coefs) %>%
  filter(term != "(Intercept)") %>% # 排除截距，只看自变量
  group_by(Grouping) %>%
  summarise(keep_vars = list(term[estimate >= 0]), .groups = "drop")

3. 动态构建公式，重新拟合模型 #

接下来我们把筛选好的保留变量和原数据结合，动态生成每个分组对应的新公式，然后重跑模型：

# 合并保留变量信息到初始嵌套数据框
updated_models <- initial_models %>%
  left_join(coef_summary, by = "Grouping") %>%
  mutate(
    # 动态构建公式：如果没有正系数自变量，就只保留截距；否则用rate ~ 保留的变量
    formula_str = map(keep_vars, ~if(length(.x) == 0) "rate ~ 1" else paste("rate ~", paste(.x, collapse = " + "))),
    formula = map(formula_str, as.formula), # 把字符串转成公式对象
    updated_model = map2(data, formula, ~lm(.y, data = .x)) # 用新公式拟合模型
  )

4. 查看最终结果 #

我们可以用broom提取更新后模型的系数，验证效果：

final_coefs <- updated_models %>%
  mutate(updated_coefs = map(updated_model, tidy)) %>%
  unnest(updated_coefs) %>%
  select(Grouping, term, estimate, p.value)

print(final_coefs)

你会看到：

• StateA的模型只保留了years（因为初始模型里months系数为负）
• StateB的模型只保留了months（因为初始模型里years系数为负）
• StateC的模型保留了两个变量（和初始模型一致，因为系数都正）

一些额外提醒 #

• 如果你后续有更多自变量，只需要修改初始模型的公式（比如rate ~ years + months + other_var），后面的代码可以直接复用，因为是动态提取变量的
• 代码里考虑了极端情况：如果某个分组的所有自变量系数都是负的，模型会自动变成只有截距项的rate ~ 1
• 用nest()+map的组合比旧版的do()更灵活，也更容易调试

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