r - 在具有包含数据框的列表列的 tibble 中，如何使用自定义函数包装 mutate(foo = map2(...)) ？

Question

我想围绕涉及 dplyr::mutate() 和 purrr::map2() 的过程编写包装函数。

为了演示，请考虑以下名为 trb 的 tibble:

df_1 <- mtcars[, c("am", "disp")]
df_2 <- mtcars[, c("mpg", "carb")]

trb <-
  tibble::tibble(dat_a = list(df_1),
                 dat_b = list(df_2))

trb
#> # A tibble: 1 x 2
#>   dat_a         dat_b        
#>   <list>        <list>       
#> 1 <df [32 x 2]> <df [32 x 2]>

我想改变 trb 中的另一列，称为 dat_c，它将包含一个数据框，其中一列来自 dat_a，一列来自数据_b。下面的代码允许我实现它:

library(dplyr)
library(purrr)

output <- 
  trb %>%
  mutate(dat_c = map2(.x = dat_a, .y = dat_b, .f = ~data.frame(my_lovely_am = .x$am, 
                                                               suberb_carb_col = .y$carb)))

output %>%
  pull(dat_c)
#> [[1]]
#>    my_lovely_am suberb_carb_col
#> 1             1               4
#> 2             1               4
#> 3             1               1
#> 4             0               1
#> 5             0               2
#> 6             0               1
# I removed the rest of the rows

如何将上面的 mutate() 过程包装在自定义函数中？特别有问题的是在引用 .x$bar 和 .y$foo 时。如何指定要从包装函数的参数中获取的那些列名称？

我想象的是一个类似于以下内容的自定义函数:

create_dat_c <- function(.trb, colname_dat_a, colname_dat_b, header_a, header_b) {
  .trb %>%
    mutate(dat_c = map2(.x = dat_a, .y = dat_b, .f = ~data.frame(header_a = .x$colname_dat_a, 
                                                                 header_b = .y$colname_dat_b)))
}

并被调用:

create_dat_c(trb, 
             colname_dat_a = am, 
             colname_dat_b = carb, 
             header_a = "splendid_am", 
             header_b = "wonderful_carb")

# and returns:
## # A tibble: 1 x 3
##   dat_a         dat_b         dat_c        
##   <list>        <list>        <list>       
## 1 <df [32 x 2]> <df [32 x 2]> <df [32 x 2]>  <<-~-~- dat_c has 2 cols: splendid_am & wonderful_carb

总而言之，它是 data.frame(header_a = .x$colname_dat_a, header_b = .y$colname_dat_b) 的一部分，我为此感到困扰。如何让它与 wrapper 的参数配合良好？

Answer 1

这是执行此操作的函数 -

library(dplyr)
library(purrr)

create_dat_c <- function(.trb, colname_dat_a, colname_dat_b, header_a, header_b) {
  .trb %>%
    mutate(dat_c = map2(.x = dat_a, .y = dat_b, 
                        .f = ~tibble(!!header_a := .x %>% pull({{colname_dat_a}}), 
                                     !!header_b := .y %>% pull({{colname_dat_b}}))))
}


result <- create_dat_c(trb, 
             colname_dat_a = am, 
             colname_dat_b = carb, 
             header_a = "splendid_am", 
             header_b = "wonderful_carb")

result
# A tibble: 1 x 3
#  dat_a         dat_b         dat_c            
#  <list>        <list>        <list>           
#1 <df [32 × 2]> <df [32 × 2]> <tibble [32 × 2]>

result$dat_c

#[[1]]
# A tibble: 32 x 2
#   splendid_am wonderful_carb
#         <dbl>          <dbl>
# 1           1              4
# 2           1              4
# 3           1              1
# 4           0              1
# 5           0              2
# 6           0              1
# 7           0              4
# 8           0              2
# 9           0              2
#10           0              4
# … with 22 more rows

data.frame 不支持 !!name := 语法，这就是我使用 tibble 的原因。如果您倾向于使用 data.frame，您可以这样做 -

create_dat_c <- function(.trb, colname_dat_a, colname_dat_b, header_a, header_b) {
  .trb %>%
    mutate(dat_c = map2(.x = dat_a, .y = dat_b, 
                        .f = ~setNames(data.frame(.x %>% pull({{colname_dat_a}}), 
                                                  .y %>% pull({{colname_dat_b}})), c(header_a, header_b))))
}