多个 ggpredict 对象的平均值

Question

在数据集的 10 个不同子集上拟合相同的模型后，我生成了 10 个模型摘要，如下所示

library(mice)
data("nhanes")
head(nhanes)
imp <- mice(nhanes, print = FALSE, m = 10, seed = 24415)
df <- complete(imp, "long")
model_fit <- lapply(1:10, function(i) {
  model = lm(bmi ~ age + hyp + chl,
             data = subset(df, `.imp`==i))
})

由此我得到了不同的

ggpredict

物体

ggpredict(model_fit[[1]], c("age", "hyp"))
ggpredict(model_fit[[2]], c("age", "hyp"))
ggpredict(model_fit[[3]], c("age", "hyp"))
ggpredict(model_fit[[4]], c("age", "hyp"))
ggpredict(model_fit[[5]], c("age", "hyp"))
ggpredict(model_fit[[6]], c("age", "hyp"))
ggpredict(model_fit[[7]], c("age", "hyp"))
ggpredict(model_fit[[8]], c("age", "hyp"))
ggpredict(model_fit[[9]], c("age", "hyp"))
ggpredict(model_fit[[10]], c("age", "hyp"))

我正在寻找一种有效的方法来a）估计所有

ggpredict

对象的平均值b）使用ggplot函数绘制它。

到目前为止，我尝试将每个

ggpredict

函数的结果存储为列表对象和

`Reduce(`+`, list_ggpred)/length(list_ggpred)`

我收到警告，

 " In Ops.factor(left, right) : `+1 not meaningful for factors.

任何建议都将受到高度赞赏。谢谢。

Answer 1

我可能误解了，但一个潜在的选择可能是：

library(mice)
library(ggeffects)

data("nhanes")
head(nhanes)
#>   age  bmi hyp chl
#> 1   1   NA  NA  NA
#> 2   2 22.7   1 187
#> 3   1   NA   1 187
#> 4   3   NA  NA  NA
#> 5   1 20.4   1 113
#> 6   3   NA  NA 184
imp <- mice(nhanes, print = FALSE, m = 10, seed = 24415)
df <- complete(imp, "long")
model_fit <- lapply(1:10, function(i) {
  model = lm(bmi ~ age + hyp + chl,
             data = subset(df, `.imp`==i))
})

library(tidyverse)
list_of_results <- map(model_fit, ggpredict, c("age", "hyp"))
ggpredicts <- map(list_of_results, `[[`, "predicted")
map(ggpredicts, mean)
#> [[1]]
#> [1] 25.93424
#> 
#> [[2]]
#> [1] 26.01019
#> 
#> [[3]]
#> [1] 26.18797
#> 
#> [[4]]
#> [1] 26.69359
#> 
#> [[5]]
#> [1] 25.90896
#> 
#> [[6]]
#> [1] 26.26845
#> 
#> [[7]]
#> [1] 26.10574
#> 
#> [[8]]
#> [1] 25.81957
#> 
#> [[9]]
#> [1] 26.34521
#> 
#> [[10]]
#> [1] 26.89521

df <- bind_cols(map(ggpredicts, mean))
colnames(df) <- paste0("Model_", str_pad(1:10, 2, pad = "0"))
df %>%
  pivot_longer(everything(),
               values_to = "mean prediction",
               names_to = "model") %>%
  ggplot(aes(x = `model`, y = `mean prediction`)) +
  geom_col() +
  theme_bw()

^{创建于 2024-04-24，使用 reprex v2.1.0}

这接近您的预期结果吗？