使用 broom 和 dplyr 合并数据框中的所有观测值的估计模型后进行预测答案

【问题标题】：Make predictions after merging estimated models in a dataframe for all observations using broom and dplyr使用 broom 和 dplyr 合并数据框中的所有观测值的估计模型后进行预测
【发布时间】：2021-04-29 20:30:42
【问题描述】：

我正在处理一个建模问题，我必须使用特定变量估计每组的多个模型。在每组拥有所有模型之后，我需要计算所有模型的估计值（拟合值）和标准误差（se）。我发现我们可以为此使用broom 和dplyr。因此，我使用iris 数据勾勒了下一个代码：

library(dplyr)
library(broom)
#Data
data("iris")
#Code
iris2 <- iris %>% group_by(Species)

数据iris2 有一个基于Species 的组。有了这个，我使用下一个代码计算不同的模型：

#Models
models <- iris2 %>% 
  do(
  model1 = lm(Sepal.Length~Sepal.Width, data = .),
  model2 = lm(Sepal.Width~Petal.Width, data = .),
  model3 = lm(Petal.Width~Sepal.Length+Sepal.Width, data = .),
  model4 = lm(Petal.Width~Petal.Length+Sepal.Length, data = .))

产生：

models
# A tibble: 3 x 5
# Rowwise: 
  Species    model1 model2 model3 model4
  <fct>      <list> <list> <list> <list>
1 setosa     <lm>   <lm>   <lm>   <lm>  
2 versicolor <lm>   <lm>   <lm>   <lm>  
3 virginica  <lm>   <lm>   <lm>   <lm>

一切都很好。现在，我需要使用四个模型计算整个数据集iris2 的预测。我使用合并方法将模型添加到 iris2 数据框：

#Merge with original data
Merged <- iris2 %>%
  left_join(models)

此时，数据包含所有模型，但我不确定如何继续计算拟合值和标准误差。最后，对于iris2 中的所有观察，我希望每个模型有两个额外的列，例如predict.mod1 和se.mod1 直到predict.mod4 和se.mod4。

这是我的主要问题，因为我不知道如何使用 predict() 来获取每个 model1、model2、model3 和 model4 来计算拟合值和 se 值。我知道我可以使用 predict() 和 predict(model,data,se=T)$$se.fit 来获取具有一个模型的隔离数据框中的值，但在这种情况下，我在合并操作后有多个模型。

我检查了网站上的一些帖子，他们使用mutate(result = map2(fit, data, predict)) 来创建估算值。我尝试了类似的方法，但没有奏效。

非常感谢您的帮助。

【问题讨论】：

@akrun 非常感谢先生，我是使用这些功能的新手。您能否提供一个适用于安装和 SE 的答案？国王问候！

标签： r dplyr broom

【解决方案1】：

无需分离数据集并加入，可以嵌套后在相同数据中创建模型

library(dplyr)
library(broom)
iris1 <- iris %>% 
    nest_by(Species) %>% 
    mutate(model1 = list(lm(Sepal.Length ~ Sepal.Width, data = data)),
           model2 = list(lm(Sepal.Width~Petal.Width, data = data)), 
           model3 = list(lm(Petal.Width~Sepal.Length+Sepal.Width, data = data)),
           model4 = list(lm(Petal.Width~Petal.Length+Sepal.Length, data = data)))

-输出

iris1
# A tibble: 3 x 6
# Rowwise:  Species
#  Species              data model1 model2 model3 model4
#  <fct>      <list<tibble>> <list> <list> <list> <list>
#1 setosa           [50 × 4] <lm>   <lm>   <lm>   <lm>  
#2 versicolor       [50 × 4] <lm>   <lm>   <lm>   <lm>  
#3 virginica        [50 × 4] <lm>   <lm>   <lm>   <lm>

在@LMc 使用的类似管道中创建列，除了可以传入“数据”（此处不需要，除非有不同的数据）

iris1 %>% 
 mutate(across(starts_with('model'), 
    list(se = ~ list(tidy(.)$std.error), 
        predict = ~ list(predict(., data)))))
# A tibble: 3 x 14
# Rowwise:  Species
#  Species              data model1 model2 model3 model4 model1_se model1_predict model2_se model2_predict model3_se model3_predict model4_se
#  <fct>      <list<tibble>> <list> <list> <list> <list> <list>    <list>         <list>    <list>         <list>    <list>         <list>   
#1 setosa           [50 × 4] <lm>   <lm>   <lm>   <lm>   <dbl [2]> <dbl [50]>     <dbl [2]> <dbl [50]>     <dbl [3]> <dbl [50]>     <dbl [3]>
#2 versicolor       [50 × 4] <lm>   <lm>   <lm>   <lm>   <dbl [2]> <dbl [50]>     <dbl [2]> <dbl [50]>     <dbl [3]> <dbl [50]>     <dbl [3]>
#3 virginica        [50 × 4] <lm>   <lm>   <lm>   <lm>   <dbl [2]> <dbl [50]>     <dbl [2]> <dbl [50]>     <dbl [3]> <dbl [50]>     <dbl [3]>
# … with 1 more variable: model4_predict <list>

从嵌套数据中，可以是unested。在这里，我们是selecting 具有相同长度的列（model 列是不同的结构）

library(tidyr)
iris1 %>% 
 mutate(across(starts_with('model'), 
  list(se = ~ list(tidy(.)$std.error), 
    predict = ~ list(predict(., data))))) %>% 
 ungroup %>% 
 select(Species, data, ends_with('predict')) %>%
 unnest(-Species)
# A tibble: 150 x 9
#   Species Sepal.Length Sepal.Width Petal.Length Petal.Width model1_predict model2_predict model3_predict model4_predict
#   <fct>          <dbl>       <dbl>        <dbl>       <dbl>          <dbl>          <dbl>          <dbl>          <dbl>
# 1 setosa           5.1         3.5          1.4         0.2           5.06           3.39          0.254          0.241
# 2 setosa           4.9         3            1.4         0.2           4.71           3.39          0.232          0.229
# 3 setosa           4.7         3.2          1.3         0.2           4.85           3.39          0.221          0.200
# 4 setosa           4.6         3.1          1.5         0.2           4.78           3.39          0.212          0.228
# 5 setosa           5           3.6          1.4         0.2           5.12           3.39          0.248          0.235
# 6 setosa           5.4         3.9          1.7         0.4           5.33           3.56          0.281          0.310
# 7 setosa           4.6         3.4          1.4         0.3           4.99           3.47          0.217          0.211
# 8 setosa           5           3.4          1.5         0.2           4.99           3.39          0.245          0.252
# 9 setosa           4.4         2.9          1.4         0.2           4.64           3.39          0.195          0.199
#10 setosa           4.9         3.1          1.5         0.1           4.78           3.31          0.233          0.246
# … with 140 more rows

或者使用predict中的se

iris1 %>% 
  mutate(across(starts_with('model'), 
   list(se = ~ list(predict(., data, se = TRUE)$se.fit), 
         predict = ~ list(predict(., data))))) %>% 
  ungroup %>%
  select(-matches('^model\\d+$')) %>%
  unnest(-Species)

【讨论】：

感谢您的快速回复，但我想使用该模型计算预测。这就是我合并数据的原因。我需要使用predict()。你能帮忙吗？
我还需要在新列中提取预测值和标准值。
@StackGuy 抱歉，正在处理其他事情。会看看
非常感谢您的更新、我的问题以及我合并到 Merged 的原因是因为我需要将使用 predict() 的预测和使用 predict(.,se=TRUE)$se.fit 的错误添加到新的数据框中pred.mod1、...、pred.mod4 等列。您的解决方案非常好，但我可以拥有整个数据（150 行）。你有什么办法可以帮助我吗？非常感谢您的帮助。
@StackGuy 我用unnest更新了帖子。