dplyr 中的多元线性模型预测

Multiple linear model prediction in dplyr

我正在尝试使用下面的脚本使用 dplyr 同时为多个模型生成预测。不幸的是,这会导致没有真正意义的重复数据。我想要的只是原始数据以及 2 个模型列(每个模型 1 个)和 2 个带有预测值的列。 谢谢

library(modelr)
install.packages("gapminder")
library(gapminder)                           
data(gapminder) 

d<-gapminder %>% 
  group_by(continent) %>%
  nest() %>% 
  mutate(model = data %>% map(~lm(lifeExp ~ pop, data = .))) %>% 
  mutate(model = data %>% map(~lm(lifeExp ~ pop + gdpPercap , data = .))) %>% 
  mutate(Pred = map2(model, data, predict)) %>% 
  mutate(Pred1 = map2(model, data, predict)) %>% 
  unnest(Pred,Pred1 data) ```

我们可以使用 nest_by 并在 mutate 中创建模型列,然后 ungroup 删除 nest_by 创建的 rowwise 属性,循环'model' 和 'data' 列 pmap,按照 selection 的顺序提取列,即 ..1 -> 数据,..2 -> 模型 1 和 ..3-> 模型 3。在 'data' (..1) 中创建新的“Pred”列,删除 selectunest 中的 model 列 'data'

library(dplyr)
library(purrr)
library(tidyr)
gapminder %>%
     nest_by(continent)  %>% 
     mutate(model1 = list(lm(lifeExp ~ pop, data = data)),
            model2 = list(lm(lifeExp ~ pop + gdpPercap, data = data ))) %>% 
     ungroup %>% 
     mutate(data = pmap(select(., data, model1, model2),  
          ~ ..1 %>%
              mutate(Pred1 = predict(..2, ..1), Pred2 = predict(..3, ..1)))) %>%
    select(-model1, -model2) %>%
    unnest(c(data))
# A tibble: 1,704 x 8
#   continent country  year lifeExp      pop gdpPercap Pred1 Pred2
#   <fct>     <fct>   <int>   <dbl>    <int>     <dbl> <dbl> <dbl>
# 1 Africa    Algeria  1952    43.1  9279525     2449.  48.8  49.2
# 2 Africa    Algeria  1957    45.7 10270856     3014.  48.9  50.0
# 3 Africa    Algeria  1962    48.3 11000948     2551.  48.9  49.4
# 4 Africa    Algeria  1967    51.4 12760499     3247.  49.1  50.5
# 5 Africa    Algeria  1972    54.5 14760787     4183.  49.2  52.0
# 6 Africa    Algeria  1977    58.0 17152804     4910.  49.4  53.2
# 7 Africa    Algeria  1982    61.4 20033753     5745.  49.6  54.6
# 8 Africa    Algeria  1987    65.8 23254956     5681.  49.8  54.7
# 9 Africa    Algeria  1992    67.7 26298373     5023.  50.0  54.0
#10 Africa    Algeria  1997    69.2 29072015     4797.  50.2  53.9
# … with 1,694 more rows

或者不使用 pmap,我们可以使用 acrossmutate 创建新列,然后 unnest

gapminder %>%
     nest_by(continent) %>% 
     mutate(model1 = list(lm(lifeExp ~ pop, data = data)),
            model2 = list(lm(lifeExp ~ pop + gdpPercap, data = data )),
            across(starts_with('model'),  ~ list(Predict = predict(., data)),
             .names = "{.col}_Predict")) %>% 
     select(-model1, -model2)  %>%
     ungroup %>% 
     unnest(c(data, model1_Predict, model2_Predict))

-输出

# A tibble: 1,704 x 8
#   continent country  year lifeExp      pop gdpPercap model1_Predict model2_Predict
#   <fct>     <fct>   <int>   <dbl>    <int>     <dbl>          <dbl>          <dbl>
# 1 Africa    Algeria  1952    43.1  9279525     2449.           48.8           49.2
# 2 Africa    Algeria  1957    45.7 10270856     3014.           48.9           50.0
# 3 Africa    Algeria  1962    48.3 11000948     2551.           48.9           49.4
# 4 Africa    Algeria  1967    51.4 12760499     3247.           49.1           50.5
# 5 Africa    Algeria  1972    54.5 14760787     4183.           49.2           52.0
# 6 Africa    Algeria  1977    58.0 17152804     4910.           49.4           53.2
# 7 Africa    Algeria  1982    61.4 20033753     5745.           49.6           54.6
# 8 Africa    Algeria  1987    65.8 23254956     5681.           49.8           54.7
# 9 Africa    Algeria  1992    67.7 26298373     5023.           50.0           54.0
#10 Africa    Algeria  1997    69.2 29072015     4797.           50.2           53.9
# … with 1,694 more rows