如何使用非标准评估NSE评估data.table上的参数?

xia*_*dai 4 r data.table nse

说我有以下

library(data.table)
cars1 = setDT(copy(cars))
cars2 = setDT(copy(cars))

car_list = list(cars1, cars2)
class(car_list) <- "dd"

`[.dd` <- function(x,...) {
  code = rlang::enquos(...)
  cars1 = x[[1]]
  rlang::eval_tidy(quo(cars1[!!!code]))
}

car_list[,.N, by = speed]
Run Code Online (Sandbox Code Playgroud)

所以我想在上执行任意操作cars1,并cars2通过定义[.dd函数,这样不管我投入...得到由执行cars1cars2使用[data.table语法如

car_list[,.N, by = speed] 应该执行以下操作

cars1[,.N, by = speed]
cars2[,.N, by = speed]
Run Code Online (Sandbox Code Playgroud)

我也想要

car_list[,speed*2]
Run Code Online (Sandbox Code Playgroud)

去做

cars1[,speed*2]
cars2[,speed*2]
Run Code Online (Sandbox Code Playgroud)

基本上,...[.dd必须接受任意代码。

我需要以某种方式捕获它,...所以我尝试去做code = rlang::enquos(...),然后rlang::eval_tidy(quo(cars1[!!!code]))不起作用并给出了错误

[.data.table(cars1,〜,〜.N,by =〜speed)中的错误:参数“ i”丢失,没有默认值

Col*_*ole 5

尽管不是rlang咒语的类型,但这种方法似乎效果很好:lapply(dt_list, '[', ...)代码对我来说更具可读性,因为它明确说明了所使用的方法。如果看到的话,car_list[, .N, by = speed]我会期望使用默认data.table方法。

将其作为功能使您能够充分利用两个方面:

class(car_list) <- "dd"

`[.dd` <- function(x,...) {
 lapply(x, '[', ...)
}

car_list[, .N, speed]
car_list[, speed * 2]
car_list[, .(.N, max(dist)), speed]
car_list[, `:=` (more_speed = speed+5)]
Run Code Online (Sandbox Code Playgroud)

以下是该方法的一些示例:

car_list[, .N, speed]
# lapply(car_list, '[', j = .N, by = speed)
# or
# lapply(car_list, '[', , .N, speed)
[[1]]
    speed N
 1:     4 2
 2:     7 2
 3:     8 1
 4:     9 1
 5:    10 3
...
[[2]]
    speed N
 1:     4 2
 2:     7 2
 3:     8 1
 4:     9 1
 5:    10 3
...
car_list[, speed * 2]
# lapply(car_list, '[', j = speed*2)
# or
# lapply(car_list, '[', , speed*2)
[[1]]
 [1]  8  8 14 14 16 18 20 20 20 22 22 24 24 24 24 26 26
[18] 26 26 28 28 28 28 30 30 30 32 32 34 34 34 36 36 36
[35] 36 38 38 38 40 40 40 40 40 44 46 48 48 48 48 50

[[2]]
 [1]  8  8 14 14 16 18 20 20 20 22 22 24 24 24 24 26 26
[18] 26 26 28 28 28 28 30 30 30 32 32 34 34 34 36 36 36
[35] 36 38 38 38 40 40 40 40 40 44 46 48 48 48 48 50

car_list[, .(.N, max(dist)), speed]
# lapply(car_list, '[', j = list(.N, max(dist)), by = speed)
# or 
# lapply(car_list, '[', ,.(.N, max(dist)), speed)

[[1]]
    speed N  V2
 1:     4 2  10
 2:     7 2  22
 3:     8 1  16
 4:     9 1  10
 5:    10 3  34
...

[[2]]
    speed N  V2
 1:     4 2  10
 2:     7 2  22
 3:     8 1  16
 4:     9 1  10
 5:    10 3  34
...
Run Code Online (Sandbox Code Playgroud)

这适用于:=操作员:

car_list[, `:=` (more_speed = speed+5)]
# or
# lapply(car_list, '[', , `:=` (more_speed = speed+5))

car_list
[[1]]
    speed dist more_speed
 1:     4    2          9
 2:     4   10          9
 3:     7    4         12
 4:     7   22         12
 5:     8   16         13
...

[[2]]
    speed dist more_speed
 1:     4    2          9
 2:     4   10          9
 3:     7    4         12
 4:     7   22         12
 5:     8   16         13
Run Code Online (Sandbox Code Playgroud)


Rol*_*and 4

第一个基本 R 选项substitute(...())后面是do.call

library(data.table)
cars1 = setDT(copy(cars))
cars2 = setDT(copy(cars))
cars2[, speed := sort(speed, decreasing = TRUE)]

car_list = list(cars1, cars2)
class(car_list) <- "dd"

`[.dd` <- function(x,...) {
  a <- substitute(...()) #this is an alist
  expr <- quote(x[[i]])
  expr <- c(expr, a)
  res <- list()
  for (i in seq_along(x)) {
    res[[i]] <- do.call(data.table:::`[.data.table`, expr)
  }
  res
}

all.equal(
  car_list[,.N, by = speed],
  list(cars1[,.N, by = speed], cars2[,.N, by = speed])
)
#[1] TRUE

all.equal(
  car_list[, speed*2],
  list(cars1[, speed*2], cars2[, speed*2])
)
#[1] TRUE
Run Code Online (Sandbox Code Playgroud)

第二个基本 R 选项是match.call,修改调用然后评估(您可以在 中找到此方法lm):

`[.dd` <- function(x,...) {
  thecall <- match.call()
  thecall[[1]] <- quote(`[`)
  thecall[[2]] <- quote(x[[i]])
  res <- list()
  for (i in seq_along(x)) {
    res[[i]] <- eval(thecall)
  }
  res
}

all.equal(
  car_list[,.N, by = speed],
  list(cars1[,.N, by = speed], cars2[,.N, by = speed])
)
#[1] TRUE

all.equal(
  car_list[, speed*2],
  list(cars1[, speed*2], cars2[, speed*2])
)
#[1] TRUE
Run Code Online (Sandbox Code Playgroud)

我还没有测试过如果您使用这些方法是否会进行深层复制:=