将表达式传递给函数以在 data.table 中进行评估以允许内部优化

Question

预读

我在 SO 上浏览了一些材料：

• 评估传递给 data.table 的函数参数
• 评估 data.table 中的表达式
• 使用字符串访问 data.table 列

在得到我以前的问题的完美答案后，我试图一劳永逸地了解如何规范地处理data.tables函数。

潜在问题

我最终想要的是创建一个函数，该函数将一些R表达式作为输入并在 a 的上下文中对它们进行评估data.table（在 thei和jpart 中）。引用的答案告诉我，get/eval/substitute如果我的输入变得比单列更复杂，我必须使用某种组合（在这种情况下，我可以接受..string或with = FALSE方法 [1]）。

我的真实数据相当大，所以我担心计算时间。

最终，如果我想拥有完全的灵活性（即传递表达式而不是裸列名称），我明白我必须采取一种eval方法：

代码讲了一千个字，所以让我们来说明我到目前为止的发现：

设置

library(data.table)
iris <- copy(iris)
setDT(iris)

主力功能

my_fun <- function(my_i, my_j, option_sel = 1, my_data = iris, by = NULL) {
   switch(option_sel,
      {
         ## option 1 - base R deparse
         my_data[eval(parse(text = deparse(substitute(my_i)))), 
                 eval(parse(text = deparse(substitute(my_j)))),
                 by]
      },
      {
         ## option 2 - base R even shorter
         my_data[eval(substitute(my_i)), 
                 eval(substitute(my_j)),
                 by]

      },
      {
         ## option 3 - rlang
         my_data[rlang::eval_tidy(rlang::enexpr(my_i)),
                 rlang::eval_tidy(rlang::enexpr(my_j), data = .SD),
                 by]

      },
      {
         ## option 4 - if passing only simple column name strings
         ## we can use `with` (in j only)
         my_data[,
                 my_j, with = FALSE,
                 by]

      },
      {
         ## option 5 - if passing only simple column name strings 
         ## we can use ..syntax (in 'j' only)
         my_data[,
                 ..my_j]
                 # , by] ## would give a strange error

      },
      {
         ## option 6 - if passing only simple column name strings
         ## we can use `get`
         my_data[,
                 setNames(.(get(my_j)), my_j),
                 by]

      }
   )
}

结果

## added the unnecessary NULL to enforce same format
## did not want to make complicated ifs for by in the func 
## but by is needed for meaningful benchmarks later
expected <- iris[Species == "setosa", sum(Sepal.Length), NULL]
sapply(1:3, function(i) 
               isTRUE(all.equal(expected,
                                my_fun(Species == "setosa", sum(Sepal.Length), i))))
# [1] TRUE TRUE TRUE

expected <- iris[, .(Sepal.Length), NULL]
sapply(4:6, function(i)
               isTRUE(all.equal(expected,
                                my_fun(my_j = "Sepal.Length", option_sel = i))))
# [1] TRUE TRUE TRUE

问题

所有选项都有效，但在创建这个（不可否认）最小示例时，我有几个问题：

1. 为了从 中获得最大收益data.table，我必须使用内部优化器可以分析和优化的代码 [2]。那么，选项 1-3（4-6 在这里只是为了完整性并且缺乏完全的灵活性）中的哪个选项“最好”使用data.table，也就是说，这些选项中的哪一个可以进行内部优化以充分利用data.table？我的快速基准测试表明该rlang选项似乎是最快的。
2. 我意识到对于选项 3，我必须.SD在j部分中提供数据参数，而不是在i部分中。这是因为范围界定很清楚。但是为什么tidy_eval“看到”列名 ini而不是 in j？
3. 任何其他可以进一步优化的解决方案？
4. 与选项 5 一起使用会导致一个奇怪的错误。为什么？

基准

library(dplyr)
size     <- c(1e6, 1e7, 1e8)
grp_prop <- c(1e-6, 1e-4)

make_bench_dat <- function(size, grp_prop) {
   data.table(x = seq_len(size),
              g = sample(ceiling(size * grp_prop), size, grp_prop < 1))
}

res <- bench::press(
   size = size,
   grp_prop = grp_prop,
   {
      bench_dat <- make_bench_dat(size, grp_prop)
      bench::mark(
         deparse    = my_fun(TRUE, max(x), 1, bench_dat, by = "g"),
         substitute = my_fun(TRUE, max(x), 2, bench_dat, by = "g"),
         rlang      = my_fun(TRUE, max(x), 3, bench_dat, by = "g"), 
         relative = TRUE)
   }
)

summary(res) %>% select(expression, size, grp_prop, min, median)
# # A tibble: 18 x 5
#    expression      size grp_prop      min   median
#    <bch:expr>     <dbl>    <dbl> <bch:tm> <bch:tm>
#  1 deparse      1000000 0.000001  22.73ms  24.36ms
#  2 substitute   1000000 0.000001  22.56ms   25.3ms
#  3 rlang        1000000 0.000001   8.09ms   9.05ms
#  4 deparse     10000000 0.000001 274.24ms 308.72ms
#  5 substitute  10000000 0.000001 276.73ms 276.99ms
#  6 rlang       10000000 0.000001 114.52ms 119.21ms
#  7 deparse    100000000 0.000001    3.79s    3.79s
#  8 substitute 100000000 0.000001    3.92s    3.92s
#  9 rlang      100000000 0.000001    3.12s    3.12s
# 10 deparse      1000000 0.0001    29.57ms  36.25ms
# 11 substitute   1000000 0.0001    37.22ms  41.56ms
# 12 rlang        1000000 0.0001     19.3ms  24.07ms
# 13 deparse     10000000 0.0001   386.13ms 396.84ms
# 14 substitute  10000000 0.0001   330.22ms 332.42ms
# 15 rlang       10000000 0.0001   270.54ms 274.35ms
# 16 deparse    100000000 0.0001      4.51s    4.51s
# 17 substitute 100000000 0.0001       4.1s     4.1s
# 18 rlang      100000000 0.0001      2.87s    2.87s

---

[1]with = FALSE或者..columnName只在j零件中起作用。

[2]我知道，当我得到了显著的性能提升，当我更换了硬盘的方式purrr::map通过base::lapply。

Answer 1

不需要花哨的工具，只需使用基本的 R 元编程功能。

my_fun2 = function(my_i, my_j, by, my_data) {
  dtq = substitute(
    my_data[.i, .j, .by],
    list(.i=substitute(my_i), .j=substitute(my_j), .by=substitute(by))
  )
  print(dtq)
  eval(dtq)
}

my_fun2(Species == "setosa", sum(Sepal.Length), my_data=as.data.table(iris))
my_fun2(my_j = "Sepal.Length", my_data=as.data.table(iris))

通过这种方式，您可以确保 data.table 将使用所有可能的优化，就像[手动输入call 一样。

请注意，在 data.table 中，我们计划使替换更容易，请参阅 PR Rdatatable/data.table#4304 中提出的解决方案 。

然后使用额外的envvar 替代将在内部为您处理

my_fun3 = function(my_i, my_j, by, my_data) {
  my_data[.i, .j, .by, env=list(.i=substitute(my_i), .j=substitute(my_j), .by=substitute(by)), verbose=TRUE]
}
my_fun3(Species == "setosa", sum(Sepal.Length), my_data=as.data.table(iris))
#Argument 'j'  after substitute: sum(Sepal.Length)
#Argument 'i'  after substitute: Species == "setosa"
#...
my_fun3(my_j = "Sepal.Length", my_data=as.data.table(iris))
#Argument 'j'  after substitute: Sepal.Length
#...