如何在dplyr中参数化接收字符串形式列名的函数？

问题场景 #

未封装成函数时，以下代码运行正常（已补全原代码缺失的语法括号）：

new_df = group_by(groupby1, groupby2) %>%
         mutate(new_value=
            slider_helper(
                slide(cur_data()[, c('string1', 'string2')], ~.x, .before = Inf, .after = -1),
                cur_data()$string2,
                'string1',
                beta
            )
         )

尝试创建可传入字符串形式分组变量和滑动变量的函数时：

my_fun <- function(df, groupby1, groupby2, string1, string2, beta) {
    return(df %>%
        group_by({{groupby1}}, {{groupby2}}) %>%
        mutate(new_value=
            slider_helper(
                slide(cur_data()[, c({{string1}}, {{string2}})], ~.x, .before = Inf, .after = -1),
                cur_data()[[{{string2}}]],
                {{string1}},
                beta)))
}

触发如下错误：

The error occurred in group 1: "groupby1" = "groupby1", "groupby2" = "groupby2".
Caused by error in `.subset()`:
! invalid subscript type 'closure'

补充可复现示例代码（原代码存在未定义变量问题，后续会修正）：

slider_helper <- function(left, right, string1, beta) {

    cbind_helper <- function(left, right) {
        todaysDate = rep(right, nrow(left))
    return(cbind(left, todaysDate))
    }

    date_helper <- function(today, date) {
        return(1/as.integer(today - date))
    }

    df = data.frame(t(mapply(cbind_helper, left, right)))
    df$val1= mapply(date_helper, df[,'todaysDate'], df[, date])
    df$val1_product= mapply('%*%', df$val1, df[[target]]) / sapply(df$val1, FUN=sum, na.rm=T)
    df$val2= 1/seq(nrow(df), 1)
    df$val2_product= sapply(mapply('*', df$val2, df[[target]]), FUN=sum, na.rm=T) / sum(df$val2, na.rm=T)
    w_sum = beta * df$val2_product+ (1-beta) * df$val2_product
    return(w_sum)
}

my_fun <- function(df, groupby1, groupby2, string1, string2, beta) {
    return(df %>%
        group_by({{groupby1}}, {{groupby2}}) %>%
        mutate(new_value=
            slider_helper(
                slide(cur_data()[, c({{string1}}, {{string2}})], ~.x, .before = Inf, .after = -1),
                cur_data()[[{{string2}}]],
                {{string1}},
                beta)))
}

df= data.frame(sample(1:2, 20, replace=T), sample(1:2, 20, replace=T), seq(from=-1, to=.9, by = .1), seq.Date(from=as.Date('2011-01-01'), to=as.Date('2011-01-20'), by = 1))
colnames(df) = c('groupby1', 'groupby2', 'string1', 'string2')
my_fun(df, 'groupby1', 'groupby2', 'string1', 'string2', 0.5)

错误原因 #

你用了{{}}（整洁评估注入运算符）处理字符串参数，但{{}}的设计目标是解析裸变量名（比如直接传groupby1而非"groupby1"）。当传入字符串时，{{groupby1}}会尝试把字符串当作变量解析，导致类型不匹配，触发下标类型错误。

同时，cur_data()返回数据框，用[, c({{string1}}, {{string2}})]结合字符串参数的写法，也会因整洁评估逻辑引发类型问题。

正确参数化方式 #

针对接收字符串形式列名的场景，推荐两种方案：

方案1：使用.data代词直接索引 #

dplyr提供的.data代词支持直接用字符串引用列，无需整洁评估，适配纯字符串参数的场景：

my_fun <- function(df, groupby1, groupby2, string1, string2, beta) {
    df %>%
        group_by(.data[[groupby1]], .data[[groupby2]]) %>%
        mutate(new_value=
            slider_helper(
                slide(cur_data()[, c(string1, string2)], ~.x, .before = Inf, .after = -1),
                cur_data()[[string2]],
                string1,
                beta
            )
        )
}

方案2：同时兼容裸变量与字符串 #

若需要函数同时支持传入裸变量名和字符串，可用rlang::ensym()将参数转换为符号，再结合!!注入：

library(rlang)

my_fun <- function(df, groupby1, groupby2, string1, string2, beta) {
    # 将参数转换为符号
    gb1 <- ensym(groupby1)
    gb2 <- ensym(groupby2)
    s1 <- ensym(string1)
    s2 <- ensym(string2)
    
    df %>%
        group_by(!!gb1, !!gb2) %>%
        mutate(new_value=
            slider_helper(
                slide(cur_data() %>% select(!!s1, !!s2), ~.x, .before = Inf, .after = -1),
                cur_data() %>% pull(!!s2),
                as_string(s1), # 若slider_helper需要字符串则转换
                beta
            )
        )
}

可复现代码完整修正 #

原slider_helper存在未定义变量问题，结合上下文修正后的完整可运行代码：

library(dplyr)
library(slider)

slider_helper <- function(left, right, string_col, beta) {

    cbind_helper <- function(left, right) {
        todaysDate = rep(right, nrow(left))
        return(cbind(left, todaysDate))
    }

    date_helper <- function(today, date) {
        return(1/as.integer(today - date))
    }

    df = data.frame(t(mapply(cbind_helper, left, right)))
    # 修正未定义变量，用传入的字符串列名索引
    df$val1= mapply(date_helper, df[,'todaysDate'], df[, string_col])
    df$val1_product= mapply('%*%', df$val1, df[[string_col]]) / sapply(df$val1, FUN=sum, na.rm=T)
    df$val2= 1/seq(nrow(df), 1)
    df$val2_product= sapply(mapply('*', df$val2, df[[string_col]]), FUN=sum, na.rm=T) / sum(df$val2, na.rm=T)
    # 修正原代码重复使用val2_product的错误
    w_sum = beta * df$val2_product + (1-beta) * df$val1_product
    return(w_sum)
}

my_fun <- function(df, groupby1, groupby2, string1, string2, beta) {
    df %>%
        group_by(.data[[groupby1]], .data[[groupby2]]) %>%
        mutate(new_value=
            slider_helper(
                slide(cur_data()[, c(string1, string2)], ~.x, .before = Inf, .after = -1),
                cur_data()[[string2]],
                string1,
                beta
            )
        )
}

# 构造测试数据
df= data.frame(
    sample(1:2, 20, replace=T), 
    sample(1:2, 20, replace=T), 
    seq(from=-1, to=.9, by = .1), 
    seq.Date(from=as.Date('2011-01-01'), to=as.Date('2011-01-20'), by = 1)
)
colnames(df) = c('groupby1', 'groupby2', 'string1', 'string2')

# 调用函数并输出结果
result <- my_fun(df, 'groupby1', 'groupby2', 'string1', 'string2', 0.5)
print(result)

内容的提问来源于stack exchange，提问作者GBPU