创建一个支持带引号和不带引号的参数的函数（使用 data.table），然后在 purrr::map （或 lapply）中工作

Question

我有以下仅适用于引用变量的函数：

library(data.table) # version 1.11.8
library(purrr)

col_count <- function(dt, vars = NULL){
  dt[, .N, by = vars]
}

我已经成功地创建了基本相同的函数，它能够接收带引号和不带引号的变量（感谢 data.table 中的“by”参数，它接收列表或字符向量）。

col_count2 <- function(dt, ...){
  vars <- NULL
  try(if(is.character(...)) {vars <- unlist(eval(substitute(...)))}, silent = TRUE)

  if(is.null(vars)) vars <- substitute(list(...))

  dt[, .N, by = vars]
}

dt_iris <- data.table::as.data.table(iris)

identical(col_count2(dt_iris, Petal.Width, Species), 
          col_count2(dt_iris, c('Petal.Width', 'Species')))

[1] TRUE

现在我希望我的函数能够使用 purrr::map（或 lapply）进行迭代，如下所示：

purrr::map(colnames(dt_iris), ~ col_count(dt_iris, .))

哪个有效。

但是

purrr::map(colnames(dt_iris), ~ col_count2(dt_iris, .))

Error in eval(bysub, x, parent.frame()) : object '.' not found 

这是来自 data.table 的消息，它接收 '.'作为 'by =' 表达式中的 vars 变量。 purrr::map 发送 '.'并且因为这不是一个字符，所以它直接指向：

vars <- substitute(list(...))

我猜有更好的方法来解决引用/取消引用问题并保持在data.table 范围内。

Answer 1

我们可以使用：

library(data.table)

col_count2 <- function(dt, ...){
   vars <- NULL 
   tryCatch({vars <- list(...)[[1]]}, error = function(e) {})
   if(!is.character(vars)) vars <- as.character(substitute(list(...))[-1])
   dt[, .N, by = vars]
}

identical(col_count2(dt_iris, Petal.Width, Species), 
          col_count2(dt_iris, c('Petal.Width', 'Species')))
#[1] TRUE

purrr::map(colnames(dt_iris), col_count2, dt = dt_iris)

#[[1]]
#    Sepal.Length  N
# 1:          5.1  9
# 2:          4.9  6
# 3:          4.7  2
# 4:          4.6  4
#....

#[[2]]
#    Sepal.Width  N
# 1:         3.5  6
# 2:         3.0 26
# 3:         3.2 13
# 4:         3.1 11
#....
#....