несколько карт для изменения фрейма данных и добавления столбца

Question

Я работаю с некоторыми данными, которые выглядят следующим образом:

# A tibble: 2 x 3
  splits          id        inner_resamples 
  <named list>    <chr>     <named list>    
1 <split [20/20]> Resample1 <tibble [6 x 2]>
2 <split [20/20]> Resample2 <tibble [6 x 2]>

Я хочу сделать map над столбцом inner_resamples и map снова над столбцом splits вкаждый столбец inner_resamples. Для каждого списка я хотел бы снова map.

Способ сделать это - использовать функцию analysis из пакета rsample.

map(cv_rolling$inner_resamples$`1`$splits, ~ analysis(.x)) %>% tail()

Что бы я хотелкак сделать, это сопоставить каждый из выходов и создать новые данные 7 столбцов:

    > map(cv_rolling$inner_resamples$`1`$splits, ~ analysis(.x)) %>% tail()
[[1]]
# A tibble: 2 x 4
  time       ID    Value   out
  <date>     <chr> <dbl> <dbl>
1 2016-12-13 CAT1   796.     1
2 2016-12-14 CAT1   797.     0

[[2]]
# A tibble: 2 x 4
  time       ID    Value   out
  <date>     <chr> <dbl> <dbl>
1 2016-12-15 CAT1   798.     1
2 2016-12-16 CAT1   791.     0

[[3]]
# A tibble: 2 x 4
  time       ID    Value   out
  <date>     <chr> <dbl> <dbl>
1 2016-12-19 CAT1   794.     1
2 2016-12-20 CAT1   796.     0

[[4]]
# A tibble: 2 x 4
  time       ID    Value   out
  <date>     <chr> <dbl> <dbl>
1 2016-12-21 CAT1   795.     0
2 2016-12-22 CAT1   791.     0

[[5]]
# A tibble: 2 x 4
  time       ID    Value   out
  <date>     <chr> <dbl> <dbl>
1 2016-12-23 CAT1   790.     0
2 2016-12-27 CAT1   792.     1

[[6]]
# A tibble: 2 x 4
  time       ID    Value   out
  <date>     <chr> <dbl> <dbl>
1 2016-12-28 CAT1   785.     0
2 2016-12-29 CAT1   783.     0

Ожидаемый результат будет (для 1 из выходов)

[[6]]
# A tibble: 2 x 4
  time       ID    Value   out    NEWCOL
  <date>     <chr> <dbl> <dbl>    
1 2016-12-28 CAT1   785.     0    8677 
2 2016-12-29 CAT1   783.     0    8757

Однако я быхотел бы также сделать это для каждого N в данных:

map(cv_rolling$inner_resamples$`N`$splits, ~ analysis(.x)) %>% tail()

Где N здесь можно получить доступ:

cv_rolling$inner_resamples[[1]]
cv_rolling$inner_resamples[[2]]
cv_rolling$inner_resamples[[N]]

Новые данные:

structure(list(time = structure(c(17136, 17137, 17140, 17141, 
17142, 17143, 17144, 17147, 17148, 17149, 17150, 17151, 17154, 
17155, 17156, 17157, 17158, 17162, 17163, 17164, 17165, 17136, 
17137, 17140, 17141, 17142, 17143, 17144, 17147, 17148, 17149, 
17150, 17151, 17154, 17155, 17156, 17157, 17158, 17162, 17163, 
17164, 17165), class = "Date"), ID = c("CAT1", "CAT1", "CAT1", 
"CAT1", "CAT1", "CAT1", "CAT1", "CAT1", "CAT1", "CAT1", "CAT1", 
"CAT1", "CAT1", "CAT1", "CAT1", "CAT1", "CAT1", "CAT1", "CAT1", 
"CAT1", "CAT1", "CAT2", "CAT2", "CAT2", "CAT2", "CAT2", "CAT2", 
"CAT2", "CAT2", "CAT2", "CAT2", "CAT2", "CAT2", "CAT2", "CAT2", 
"CAT2", "CAT2", "CAT2", "CAT2", "CAT2", "CAT2", "CAT2"), Value = c(747.919983, 
750.5, 762.52002, 759.109985, 771.190002, 776.419983, 789.289978, 
789.27002, 796.099976, 797.070007, 797.849976, 790.799988, 794.200012, 
796.419983, 794.559998, 791.26001, 789.909973, 791.549988, 785.049988, 
782.789978, 771.820007, 56.283112, 56.330643, 57.252861, 56.996159, 
58.346195, 58.003925, 58.916634, 59.106773, 59.876858, 59.591648, 
59.496574, 59.230362, 60.485325, 60.409275, 60.409275, 60.418777, 
60.124058, 60.162071, 59.886375, 59.800812, 59.078251), out = c(0, 
1, 1, 0, 1, 1, 1, 1, 1, 0, 1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 
1, 1, 0, 1, 0, 1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0)), row.names = c(NA, 
-42L), index_quo = ~date, index_time_zone = "UTC", class = c("tbl_time", 
"tbl_df", "tbl", "data.frame"))

Также необходимо выполнить:

library(rsample)
library(purrr)
library(tibbletime)

periods_train <- 2
periods_test  <- 1
skip_span     <- 1

cv_rolling <- nested_cv(df, 
                        outside = group_vfold_cv(group = "ID"),
                        inside = rolling_origin(
                          initial    = periods_train,
                          assess     = periods_test,
                          cumulative = FALSE,
                          skip       = skip_span))

Где можно выполнить следующее:

map(cv_rolling$inner_resamples$`2`$splits, ~ analysis(.x))

Именно из этого я пытаюсь изменить / создать новые данные.

Answer 1

Я не уверен, какую функцию вы хотите применить для генерации NEWCOL, но вот несколько игрушечных примеров для ваших данных, которые просто делят исходный столбец Value на 10:

cv_rolling %>% 
  mutate(data  = map(inner_resamples, "splits"),
         data2 = map_depth(data, 2, rsample::analysis),
         data3 = map_depth(data2, 2, ~ mutate(.x, NEWCOL = Value/10)))

Если вызов mutate довольно сложен, вы можете поместить его в вспомогательную функцию.

mutate_helper <- function(df) {
  mutate(df, NEWCOL = Value/10)
}

cv_rolling %>% 
  mutate(data  = map(inner_resamples, "splits"),
         data2 = map_depth(data, 2, rsample::analysis),
         data3 = map_depth(data2, 2, mutate_helper))