在 dplyr 函数中创建和访问动态列名

如何解决在 dplyr 函数中创建和访问动态列名

library(rlang)
library(dplyr)
library(lubridate)

example = tibble(
  date = today() + c(1:6),foo = rnorm(6),)

do.some.stuff <- function(data,foo.col){
  sum.col = parse_expr(paste(expr_text(enexpr(foo.col)),"sum",sep="."))
  max.col = parse_expr(paste(expr_text(enexpr(foo.col)),"max",sep="."))
  cnt.col = parse_expr(paste(expr_text(enexpr(foo.col)),"cnt",sep="."))
  
  select(data,date,{{ foo.col }}) %>% 
    filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
      "{{ foo.col }}.cnt" := cumsum( !is.na({{ foo.col }}) ),"{{ foo.col }}.sum" := cumsum({{ foo.col }}),"{{ foo.col }}.max" := cummax( {{ sum.col }} ),"{{ foo.col }}.mu" :=  {{ sum.col }} / {{ cnt.col }}
    )
}

do.some.stuff(example,foo)

所以上面的代码工作得很好，但有点难看，尤其是三行parse_expr。我可以将函数重写为：

do.some.stuff <- function(data,foo.col){
  sum.col = paste(expr_text(enexpr(foo.col)),sep=".")
  max.col = paste(expr_text(enexpr(foo.col)),sep=".")
  cnt.col = paste(expr_text(enexpr(foo.col)),sep=".")
  
  select(data,{{ foo.col }}) %>% 
    filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
      cnt.col := cumsum( !is.na({{ foo.col }}) ),sum.col := cumsum({{ foo.col }}),max.col := cummax( {{ parse_expr(sum.col) }} ),"{{ foo.col }}.mu" :=  {{ parse_expr(sum.col) }} / {{ parse_expr(cnt.col) }}
    )
}

但也好不到哪里去。有没有其他方法可以完成同样的行为（我不想改变 df 的形状，那部分不取决于我）但踢 rlang 依赖？这现在工作得很好，但如果可能的话，我想要更干净/更容易阅读的东西。如果不是很明显，我对 R 中的元编程还不熟悉，尽管我确实有其他语言的经验。

解决方法

将 across 与 .names 参数一起使用，或者如果 foo_cnt 等带有下划线是可以的，那么只需省略 .names 参数，因为这是默认值。

library(dplyr)
library(tibble)

do.some.stuff.2 <- function(data,col) {
  cnt <- function(x) cumsum(!is.na(x))
  mx <- function(x) cummax(cumsum(x))      
  mu <- function(x) cumsum(x) / cnt(x)
  data %>%
    select(date,{{col}}) %>%
    filter(!is.na(date) & !is.na({{col}})) %>%
    mutate(across({{col}},lst(cnt,sum=cumsum,max=mx,mu),.names = "{.col}.{.fn}" ))
}
# test
do.some.stuff.2(example,foo)

给予：

# A tibble: 6 x 6
  date             foo foo.cnt   foo.sum   foo.max    foo.mu
  <date>         <dbl>   <int>     <dbl>     <dbl>     <dbl>
1 2021-02-11 -0.000202       1 -0.000202 -0.000202 -0.000202
2 2021-02-12  0.363          2  0.363     0.363     0.181   
3 2021-02-13  1.27           3  1.63      1.63      0.543   
4 2021-02-14  1.50           4  3.13      3.13      0.781   
5 2021-02-15  1.00           5  4.13      4.13      0.826   
6 2021-02-16 -0.458          6  3.67      4.13      0.612 

,

这可能是一个更简单的版本

library(rlang)
library(dplyr)
library(lubridate)

example = tibble(
  date = today() + c(1:6),foo = rnorm(6),)

# This is your initial version of the code.
do.some.stuff <- function(data,foo.col){
  sum.col = parse_expr(paste(expr_text(enexpr(foo.col)),"sum",sep="."))
  max.col = parse_expr(paste(expr_text(enexpr(foo.col)),"max",sep="."))
  cnt.col = parse_expr(paste(expr_text(enexpr(foo.col)),"cnt",sep="."))
  
  select(data,date,{{ foo.col }}) %>% 
    filter(!is.na(date) & !is.na({{ foo.col }})) %>% mutate(
      "{{ foo.col }}.cnt" := cumsum( !is.na({{ foo.col }}) ),"{{ foo.col }}.sum" := cumsum({{ foo.col }}),"{{ foo.col }}.max" := cummax( {{ sum.col }} ),"{{ foo.col }}.mu" :=  {{ sum.col }} / {{ cnt.col }}
    )
}

# Here is my version where foo.col is a character param
do.some.stuff_2 <- function(data,foo.col) {
  data %>% select(date,!!foo.col) %>% 
    filter(!is.na(date) & !is.na(!!foo.col)) %>%
    mutate(
      # Here as foo.col is a character to add new column just combine them together
      !!paste0(foo.col,".cnt") := cumsum(!is.na(.data[[foo.col]])),!!paste0(foo.col,".sum") := cumsum(.data[[foo.col]]),".max") := cummax(.data[[paste0(foo.col,".sum")]]),".mu") :=  .data[[paste0(foo.col,".sum")]] / 
                                   .data[[paste0(foo.col,".cnt")]]
    )
}

identical(do.some.stuff(example,foo),do.some.stuff_2(example,"foo"))

您可以在此处了解更多信息：https://dplyr.tidyverse.org/articles/programming.html