Pipe 结果从 map_dfr 到后续 map_dfr 以将自定义功能应用于数据组

Question

我想将某个 function （即下面的AddLags ）应用于 dataframe 的组。 为了实现这一点，我尝试使用两个连续map_dfr （一个到另一个），以便应用各自的过滤器。 对于最后一步，我正在应用自定义 function（前面提到过） - 使用map_dfr （在新对象中捕获新计算的 output 数据）。

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

# 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)   
  }
}

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

我想知道如何实现上述目标（假设这是可行的）以及我缺少什么，因为目前我得到的只是一个空的 dataframe。

奖金问题：在我写这篇文章时，我意识到必须有更好的方法来代替循环 - 例如使用group_by - 但考虑到问题的性质以及 function 输出新数据的事实，我我不确定这会是什么样子（假设一开始是可行的）。 因此，任何类型的建议/替代/最佳实践将不胜感激。

免责声明：在purrr功能方面，我是个大菜鸟，也不是经验丰富的dplyr用户，所以请原谅我的无知。

Answer 1

这是预期的 output 吗？

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)
}

^{由代表 package (v2.0.1) 于 2022 年 1 月 13 日创建}

Answer 2

正如@Limey 建议的那样，一种可能的方法是使用 group_map function：

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 方法 go