當我需要為每個元素選擇合適的模型時，如何避免for循環？

Question

我有一個包含一些模型的數據框，我想將適當的模型應用於不同數據框的每一行，然后將模型的預測值添加到該數據框的新列中

我有一個不太好的解決方案，使用for循環，要求我對應用模型的數據框進行排序。

# sort my sample data (mtcars) by cylinder, so the final data lines up
mycars <- mtcars[order(mtcars$cyl),] 

# build a linear model for each number of cylinders,
# estimating mpg from displacement
by_cyl <- group_by(mycars, cyl)
models <- by_cyl %>% do(mod = lm(mpg ~ disp, data = .))

# my inelegant solution for adding the predicted mpg into the dataset
prediction <-  c()
for (i in models$cyl){
  temp <- filter(mycars, cyl == i)
  prediction <- c(prediction, predict((models %>% filter(cyl==i))$mod[[1]], temp)) 
}
mycars$mpg.pred <- prediction

我希望能夠避免使用for循環，並且在可能的情況下也將原始日期保留為原始順序

Answer 1

使用tidyverse，其中.fitted是預測值：

library(tidyverse)

mtcars %>% 
  nest(-cyl) %>% 
  mutate(mod = map(data, ~lm(mpg ~ disp, data = .))) %>% 
  mutate(pred = map(mod, broom::augment)) %>% 
  select(pred) %>% 
  unnest()
#> # A tibble: 32 x 8
#>      mpg  disp .fitted  .resid .std.resid   .hat .sigma .cooksd
#>    <dbl> <dbl>   <dbl>   <dbl>      <dbl>  <dbl>  <dbl>   <dbl>
#>  1  21    160     19.7 -1.34       0.944  0.195    1.61 0.108  
#>  2  21    160     19.7 -1.34       0.944  0.195    1.61 0.108  
#>  3  21.4  258     20.0 -1.39       1.55   0.681    1.28 2.57   
#>  4  18.1  225     19.9  1.79      -1.36   0.311    1.40 0.419  
#>  5  19.2  168.    19.7  0.486     -0.336  0.167    1.75 0.0113 
#>  6  17.8  168.    19.7  1.89      -1.30   0.167    1.44 0.170  
#>  7  19.7  145     19.6 -0.0953     0.0711 0.284    1.77 0.00101
#>  8  22.8  108     26.3  3.48      -1.29   0.0920   2.70 0.0849 
#>  9  24.4  147.    21.0 -3.35       1.45   0.330    2.62 0.521  
#> 10  22.8  141.    21.8 -0.956      0.396  0.267    2.96 0.0286 
#> # ... with 22 more rows

^{由reprex軟件包 （v0.3.0）創建於2019-06-18}

Answer 2

這是使用dplyr ， tidyr::nest/unnest和broom 。 想法是將每個分組變量（cyl）值嵌套在一行中，使線性模型適合該行的數據，然后取消嵌套。 bind_cols部分將原始數據附加到擬合的數據上。

library(tidyverse); library(broom)
bind_cols(
  mycars, 
  mycars %>% 
    nest(-cyl) %>%
    mutate(
      fit = map(data, ~ lm(mpg ~ disp, data = .x)),
      predictions = map(fit, augment)
      ) %>%
    unnest(predictions)
)

    mpg cyl  disp  hp drat    wt  qsec vs am gear carb cyl1 mpg1 disp1  .fitted   .se.fit
1  22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1    4 22.8 108.0 26.27664 0.8551838
2  24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2    4 24.4 146.7 21.04665 1.6196357
3  22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2    4 22.8 140.8 21.84399 1.4566581
4  32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1    4 32.4  78.7 30.23629 1.2212018
5  30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2    4 30.4  75.7 30.64172 1.2945167
6  33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1    4 33.9  71.1 31.26337 1.4131700
7  21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1    4 21.5 120.1 24.64142 0.9842241
8  27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1    4 27.3  79.0 30.19575 1.2140755
9  26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2    4 26.0 120.3 24.61440 0.9875865
10 30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2    4 30.4  95.1 28.01997 0.9127723
...

Answer 3

還可以by + do.call考慮基數R：

df_list <- by(mycars, mycars$cyl, function(sub)     
   within(sub, pred - predict(lm(mpg ~ disp, data = sub)))    
)

final_df <- do.call(rbind, unname(df_list))

Rextester演示

產量

final_df

#                      mpg cyl  disp  hp drat    wt  qsec vs am gear carb     pred
# Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1 26.27664
# Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2 21.04665
# Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2 21.84399
# Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1 30.23629
# Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2 30.64172
# Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1 31.26337
# Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1 24.64142
# Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1 30.19575
# Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2 24.61440
# Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2 28.01997
# Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2 24.51980
# Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4 19.65881
# Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4 19.65881
# Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1 20.01211
# Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1 19.89314
# Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4 19.68621
# Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4 19.68621
# Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6 19.60473
# Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2 14.96452
# Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4 14.96452
# Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3 16.61772
# Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3 16.61772
# Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3 16.61772
# Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4 12.76551
# Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4 13.00112
# Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4 13.39380
# Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2 15.78916
# AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2 16.06403
# Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4 15.16087
# Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2 14.17916
# Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4 15.14123
# Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8 16.12294