Р: перестановка списков, муррр

Речь идет о перестановке списка: я выполняю перекрестную проверку, аналогичную следующему коду, где число cv_chunk произвольно: 

library(purrr)
# randomly assign to a cross validation chunk
set.seed(11)
mtcars$cv_chunk <- sample(rep(1:3), nrow(mtcars), 1)

model_confint <- mtcars %>% 
  split(.$cv_chunk) %>% 
  map(~lm(mpg ~ cyl*qsec + gear - cv_chunk, data = .)) %>% 
  map(confint, levels = 0.95) %>%
  map(t)

  names(model_confint) <- paste0("CV_", names(model_confint))

# first element of the list
$CV_1
       (Intercept)        cyl      qsec      gear   cyl:qsec
2.5 %     -54.8983 -25.691233 -8.958490 -5.175215 -0.7161008
97.5 %    215.2629   9.901694  4.322784  5.185608  1.2804372

Для дальнейшей обработки доверительных уровней каждой такой модели мне нужно перестроить model_confint таким образом, чтобы я получил данные.рамка / список для каждого коэффициента в модели. Например, для (Intercept) (и так далее для cyl, qsec, ...): 

$`(Intercept)`
       2.5 %    97.5 %
CV_1  -54.8983 215.26290
CV_2 -193.2070  84.48072
CV_3 -361.1489 545.04010
Я уверен, что есть хороший способ использовать функцию apply или пакет purrr. Но это так. застрял. Спасибо за вашу помощь.
2 3
apply

2 ответа:

Спасибо за прекрасный пример! Две интуиции, которые у меня были, облегчают эту проблему: вы можете использовать purrr::set_names, чтобы назвать свой список раньше в цикле, и вы можете избежать транспонирования, сопоставив его с фреймом данных раньше.


library(purrr)

# randomly assign to a cross validation chunk
set.seed(11)
mtcars$cv_chunk <- sample(rep(1:3), nrow(mtcars), 1)

mtcars %>% 
  split(.$cv_chunk) %>% 
# Name the list here to use it as an argument later
  set_names(paste0("CV_", names(.))) %>% 
# Map the actual list and the names of the list to create one dataframe
  map(~lm(mpg ~ cyl*qsec + gear - cv_chunk, data = .)) %>% 
  map2_dfr(.x = ., .y = names(.), function(x, y) {
    df <- as.data.frame(confint(x, levels = .95))
    df$coeffs <- rownames(df)
    df$cv_chunk <- y
    df
    }
  ) %>%
 # Split the dataframe on the "coeffs" column
  split(.$coeffs) %>%
 # Remove the "coeffs" column from each dataframe
  map(function(x) x[colnames(x) != 'coeffs'])
#> $`(Intercept)`
#>        2.5 %    97.5 % cv_chunk
#> 1   -54.8983 215.26286     CV_1
#> 6  -193.2069  84.48072     CV_2
#> 11 -361.1489 545.04010     CV_3
#> 
#> $cyl
#>        2.5 %    97.5 % cv_chunk
#> 2  -25.69123  9.901694     CV_1
#> 7  -11.44012 24.073391     CV_2
#> 12 -26.36288 16.589356     CV_3
#> 
#> $`cyl:qsec`
#>         2.5 %    97.5 % cv_chunk
#> 5  -0.7161008 1.2804372     CV_1
#> 10 -1.4870954 0.5295074     CV_2
#> 15         NA        NA     CV_3
#> 
#> $gear
#>         2.5 %    97.5 % cv_chunk
#> 4   -5.175215  5.185608     CV_1
#> 9   -3.975621  8.092960     CV_2
#> 14 -30.785104 33.533967     CV_3
#> 
#> $qsec
#>         2.5 %    97.5 % cv_chunk
#> 3   -8.958490  4.322784     CV_1
#> 8   -2.257827 11.261528     CV_2
#> 13 -17.741244 12.929339     CV_3
2

Это можно сделать с помощью broom: 

library(purrr)
library(dplyr)
library(tidyr)
# randomly assign to a cross validation chunk
set.seed(11)
mtcars$cv_chunk <- sample(seq(3), nrow(mtcars), replace = TRUE)

mtcars %>% 
  split(.$cv_chunk) %>% 
  map(~lm(mpg ~ cyl*qsec + gear - cv_chunk, data = .)) %>% 
  # the following will work uder different seed. I will report a bug to `broom``
  #map_dfr(~broom::tidy(.x, conf.int=TRUE), .id="cv_chunk")
  map_dfr(~bind_cols(broom::tidy(.x), drop_na(broom::confint_tidy(.x))), .id="cv_chunk") %>% 
  select(cv_chunk, term, conf.low, conf.high) %>% 
  split(.$term)

Правильный tidyverse способ делать вещи будет использовать group_by(term) %>% nest() %>% pull(data), но base функция split доставляет то, что вы хотите 

$`(Intercept)`
   cv_chunk        term  conf.low conf.high
1         1 (Intercept)  -54.8983 215.26286
6         2 (Intercept) -193.2069  84.48072
11        3 (Intercept) -361.1489 545.04010

$cyl
   cv_chunk term  conf.low conf.high
2         1  cyl -25.69123  9.901694
7         2  cyl -11.44012 24.073391
12        3  cyl -26.36288 16.589356

$`cyl:qsec`
   cv_chunk     term   conf.low conf.high
5         1 cyl:qsec -0.7161008 1.2804372
10        2 cyl:qsec -1.4870954 0.5295074

$gear
   cv_chunk term   conf.low conf.high
4         1 gear  -5.175215  5.185608
9         2 gear  -3.975621  8.092960
14        3 gear -30.785104 33.533967

$qsec
   cv_chunk term   conf.low conf.high
3         1 qsec  -8.958490  4.322784
8         2 qsec  -2.257827 11.261528
13        3 qsec -17.741244 12.929339
2