r-将结果从map_dfr管道传输到后续的map_dfr，以将自定义函数应用于数据组

Question

我想将某个函数(即下面的AddLags(应用于数据帧的组。为了实现这一点，我尝试使用两个连续的map_dfr(一个管道连接到另一个管道(，以便应用相应的过滤器。在最后一步中，我将应用自定义函数(前面提到(-使用map_dfr(在新对象中捕获新计算的输出数据(。

到目前为止，我的代码如下：

# dummy dataset
df <- data.frame(
date = seq(today(),length.out=12,by='month'),
dim1 = c('a','a','a','b','b','b','c','c','c','d','d','d'),
dim2 = c(1,1,1,1,1,1,2,2,2,2,2,2),
value = 1:12
)
# function to apply
AddLags <- function(df,lags_vector,target_col,date_col){
temp_lags <- map_dfc(lags_vector, 
~ df %>% 
arrange({{date_col}}) %>% 
transmute(
across(contains(target_col), lag, .x, .names = '{col}_lag_{ifelse(.x<10,paste0("0",.x),.x)}')
)
)
return(temp_lags)
}

# prepare for map_dfr approach
lags_features <- c(1,2)
dims1 <- df %>% pull(dim1) %>% unique %>% sort
dims2 <- df %>% pull(dim2) %>% unique %>% sort
# what I am struggling with
map_dfr(dims1, 
~ df %>%
filter(dim1==.x) %>%
map_dfr(dims2,
~ . %>% 
filter(dim2==.x) %>% 
AddLags(lags_features,variable,date)
)
)
# how the loop version would look like
gather_results <- data.frame()
for(d1 in dims1){
for(d2 in dims2){
tempdata <- df %>% filter(dim1==d1,dim2==dim2) %>% arrange(date)
temp <- AddLags(tempdata)
gather_results %<>% bind_rows(temp)   
}
}

本质上，我正在遍历不同的组(通过过滤(并分别应用自定义函数，同时尝试使用map_dfr来合并新计算的结果。

我想知道如何实现上述目标(假设这是可行的(，我缺少什么，因为目前我得到的只是一个空的数据帧。

奖金问题：在我写这篇文章的时候，我意识到必须有一种更好的方法来实现这一点，而不是循环——例如使用group_by——但考虑到问题的性质和函数输出新数据的事实，我不确定这会是什么样子(假设一开始是可行的(。因此，任何形式的建议/替代方案/最佳实践都将不胜感激。

免责声明：当谈到purrr功能时，我是一个大傻瓜，也不是一个经验丰富的dplyr用户，所以请原谅我的无知。

Answer 1

这是预期的输出吗？

library(tidyverse)
library(lubridate)
group_split(df, dim1, dim2) %>%
map_dfr(~ .x %>% AddLags(1:2, "value", date))
#> # A tibble: 12 × 2
#>    value_lag_01 value_lag_02
#>           <int>        <int>
#>  1           NA           NA
#>  2            1           NA
#>  3            2            1
#>  4           NA           NA
#>  5            4           NA
#>  6            5            4
#>  7           NA           NA
#>  8            7           NA
#>  9            8            7
#> 10           NA           NA
#> 11           10           NA
#> 12           11           10

数据：

# dummy dataset
df <- data.frame(
date = seq(today(), length.out = 12, by = "month"),
dim1 = c("a", "a", "a", "b", "b", "b", "c", "c", "c", "d", "d", "d"),
dim2 = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2),
value = 1:12
)
# function to apply
AddLags <- function(df, lags_vector, target_col, date_col) {
temp_lags <- map_dfc(
lags_vector,
~ df %>%
arrange({{ date_col }}) %>%
transmute(
across(contains(target_col), lag, .x, .names = '{col}_lag_{ifelse(.x<10,paste0("0",.x),.x)}')
)
)
return(temp_lags)
}

^{创建于2022-01-13由reprex包(v2.0.1(}

Answer 2

正如@Limey所建议的，一种可能的方法是使用group_map函数：

results_df <- data.frame()
results_df <- 
bind_rows(
df %>% 
group_by(dim1,dim2) %>% 
group_map(~AddLags(.,c(1,2),'value',date))
)

预期结果是：

value_lag_01 value_lag_02
<int>        <int>
1           NA           NA
2            1           NA
3            2            1
4           NA           NA
5            4           NA
6            5            4
7           NA           NA
8            7           NA
9            8            7
10           NA           NA
11           10           NA
12           11           10

然而，我个人会选择@jpdugo17方法