如何创建支持%>%管道的R语言verif()函数？

你的代码在直接调用（如verif(iris)）时能正常工作，但使用%>%管道时会失效，核心原因是：

• 管道会将前一个对象的值传递给函数参数，substitute(val)捕获到的是管道占位符.，而非原始对象名。
• 对于list(iris, cars)这类构造，列表元素是对象的副本而非引用，substitute(x)只能获取到匿名参数x，无法拿到原始对象名。

方案1：基础R实现 #

通过捕获调用栈上下文，解析管道左侧表达式或列表构造表达式，提取原始对象名称：

verif <- function(val) {
  if (is.data.frame(val)) {
    # 捕获调用上下文，区分管道与直接调用
    call <- sys.call(-1)
    if (is.call(call) && call[[1]] == quote(`%>%`)) {
      # 管道场景：提取左侧对象表达式
      return(deparse(call[[2]], backtick = TRUE))
    } else {
      # 直接调用场景
      return(deparse(substitute(val), backtick = TRUE))
    }
  } else if (is.list(val)) {
    call <- sys.call(-1)
    # 处理管道传入列表的情况
    if (is.call(call) && call[[1]] == quote(`%>%`)) {
      list_expr <- call[[2]]
      if (is.call(list_expr) && list_expr[[1]] == quote(list)) {
        # 解析list()内的元素表达式
        return(sapply(as.list(list_expr)[-1], deparse, backtick = TRUE))
      } else {
        # 传入已命名列表时返回其名称
        return(names(val))
      }
    } else {
      # 直接调用list的情况
      list_expr <- substitute(val)
      if (is.call(list_expr) && list_expr[[1]] == quote(list)) {
        return(sapply(as.list(list_expr)[-1], deparse, backtick = TRUE))
      } else {
        return(names(val))
      }
    }
  } else {
    return("Argument must be a data frame or a list.")
  }
}

测试验证：

iris %>% verif() # 返回 "iris"
list(iris, cars) %>% verif() # 返回 c("iris", "cars")
verif(list(iris, cars)) # 同样返回 c("iris", "cars")
mtcars %>% verif() # 返回 "mtcars"

方案2：用rlang包简化实现 #

rlang提供的非标准计算工具能更优雅地捕获表达式：

library(rlang)

verif <- function(val) {
  val_expr <- enexpr(val)
  
  if (is.data.frame(val)) {
    # 处理管道占位符`.`的情况
    if (is_symbol(val_expr) && as_string(val_expr) == ".") {
      pipe_call <- get_expr(parent_frame()$`_fseq`[[1]])
      return(deparse(pipe_call[[2]], backtick = TRUE))
    } else {
      return(deparse(val_expr, backtick = TRUE))
    }
  } else if (is.list(val)) {
    if (is_call(val_expr, "list")) {
      # 解析list()内的元素表达式
      return(sapply(val_expr[-1], deparse, backtick = TRUE))
    } else if (is_symbol(val_expr) && as_string(val_expr) == ".") {
      pipe_call <- get_expr(parent_frame()$`_fseq`[[1]])
      list_expr <- pipe_call[[2]]
      if (is_call(list_expr, "list")) {
        return(sapply(list_expr[-1], deparse, backtick = TRUE))
      } else {
        return(names(val))
      }
    } else {
      return(names(val))
    }
  } else {
    return("Argument must be a data frame or a list.")
  }
}

测试效果与方案1完全一致，代码更简洁。

• 若传入已命名列表（如list(df1=iris, df2=cars)），两种方案都会返回列表的命名（c("df1", "df2")），符合预期行为。
• 如果列表是通过动态构造生成的（如lapply(1:2, function(i) get(paste0("iris", i)))），由于原始对象名未保留在表达式中，无法提取，此时会返回列表的名称（若有）或NULL。

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