Question

我正在尝试给定给定数据的子集。

apply

在函数中由一个名为列表的参数

DT <- data.table(
  a = c(1:20),
  b = (3:4),
  c = (5:14),
  d = c(1:4)
)

我可能会被困在这里，但是我当然不想实现像这样的丑陋的东西。尤其是因为它不是很动态。

param <- list(a = 1:10,
              b = 2:3,
              c = c(5, 7, 10))

DT[(if (!is.null(param$a))
  a %in% param$a
  else
    TRUE)
  &
    (if (!is.null(param$b))
      b %in% param$b
     else
       TRUE)
  &
    (if (!is.null(param$c))
      c %in%  param$c
     else
       TRUE)
  &
    (if (!is.null(param$d))
      d %in% param$d
     else
       TRUE)]

有什么想法如何使用命名列表的名称在data.table或base R中以优雅的方式实现此目的，以将data.table中的对应列与关联值进行子集化？谢谢！

编辑

我用一些答案进行了微基准测试：

   a b c d
1: 1 3 5 1
2: 3 3 7 3

Answer 1

使用Map我们可以做到

DT[DT[, all(Map(`%in%`, .SD, param)), by = 1:nrow(DT)]$V1]
#   a b c d
#1: 1 3 5 1
#2: 3 3 7 3

对于每一行，我们检查DT中是否存在param中的所有元素。

感谢@Frank，这可以改进为

DT[DT[, all(mapply(`%in%`, .SD, param)), by = 1:nrow(DT), .SDcols=names(param)]$V1]

Answer 2

您可以使用CJ中的data.table（ C 罗斯 J oin）函数从列表中创建一个过滤表。

lookup <- do.call(CJ, param)
head(lookup)
#    a b  c
# 1: 1 2  5
# 2: 1 2  7
# 3: 1 2 10
# 4: 1 3  5
# 5: 1 3  7
# 6: 1 3 10

DT[
    lookup,
    on = names(lookup),
    nomatch = NULL
]
#    a b c d
# 1: 1 3 5 1
# 2: 3 3 7 3

请注意，nomatch = 0意味着lookup中不存在的DT中的任何组合都不会返回一行。

Answer 3

您可以使用call(fun, ...)和as.name构建表达式：

myp    = Filter(Negate(is.null), param)

exs = Map(function(var, val) call("%in%", var, val), var = sapply(names(myp), as.name), val = myp)
exi = Reduce(function(x,y) call("&", x, y), exs)
ex = call("[", x = as.name("DT"), i = exi)
# DT[i = a %in% 1:10 & b %in% 2:3 & c %in% c(5, 7, 10)]

eval(ex)
#    a b c d
# 1: 1 3 5 1
# 2: 3 3 7 3

通过正确地构成调用，您可以利用data.table中有效的“索引”算法（请参阅小插图包）。您还可以打开冗长的记录来获取有关param$c为int时将DT$c指定为数字的效率低下的提示：

> z <- as.call(c(as.list(ex), verbose=TRUE))
> eval(z)
Optimized subsetting with index 'c__b__a'
on= matches existing index, using index
Coercing double column i.'c' to integer to match type of x.'c'. Please avoid coercion for efficiency.
Starting bmerge ...done in 0.020sec 
   a b c d
1: 1 3 5 1
2: 3 3 7 3

也就是说，您应该使用c(5L, 7L, 10L)。

与Nathan的回答一样，联接也使用索引，但是如果param大，则在prod(lengths(param))的笛卡尔表上建立和联接会很昂贵。

@markus方法可能由于行操作而变慢，因此这是一个变体：

DT[do.call(pmin, Map(`%in%`, DT[, names(param), with=FALSE], param)) == 1L]

#    a b c d
# 1: 1 3 5 1
# 2: 3 3 7 3

诀窍是all的元素版本为pmin(...) == 1L。同样，any对应于pmax(...) == 1L。（这就是为什么{-{3}}上的对话中不包括pany / pall的原因）

Answer 4

我们可以使用DT中的names选择param中的列，将%in%应用于具有列的每个列表元素，并仅选择所有值为{{1 }}。

TRUE

Answer 5

我要添加另一个答案，因为OP提出的解决方案缺少一个关键细节：每一个如何扩展大型数据集。我经常使用记录超过100万条的数据集，因此，出于我自己的利益，我针对pmin + %in% + Map解决方案使用不同大小的数据集进行了OP提出的微基准测试实验， CJ解决方案，我独立实现了一个版本。尽管对于小型数据集，前者的速度明显更快，但后者的扩展性更好：

在我看来，相对速度开关约为200k条记录，无论要子集的字段数如何，所以我将这两个函数打包为一个供以后使用：

subsel <- function(x, sub, sel = NULL,
                   nomatch = getOption('datatable.nomatch')){
  #' function to subset data.table (x) using a named list (sub). sel
  #' can be used to return only the specified columns. algorithms
  #' copied from https://stackoverflow.com/questions/55728200/subsetting-a-data-table-based-on-a-named-list
  #' and cutoff decided on some ad hoc testing.
  if(is.null(sel)) sel <- names(x)
  if(x[, .N] < 200000L){
    return(
      x[
        do.call(
          pmin,
          Map(`%in%`, x[, .SD, .SDcols = names(sub)], sub)
        ) == 1L,
        .SD,
        .SDcols = sel,
        nomatch = nomatch
      ]
    )
  } else {
    return(
      x[
        do.call(CJ, sub),
        .SD,
        .SDcols = sel,
        on = names(sub),
        nomatch = nomatch
      ]
    )
  }
}

如果有人好奇，这是用于生成图形的代码：

require(data.table)
require(ggplot)
require(microbenchmark)
require(scales)

subsel <- function(x, sub, nomatch = NULL, sel = list()){
  if(length(sel) == 0) sel <- names(x)
  return(
    x[
      do.call(CJ, sub),
      .SD,
      .SDcols = sel,
      on = names(sub),
      nomatch = nomatch
    ]
  )
}

subsel2 <- function(x, sub, nomatch = NULL, sel = list()){
  if(length(sel) == 0) sel <- names(x)
  return(
    x[
      do.call(
        pmin,
        Map(`%in%`, x[, .SD, .SDcols = names(sub)], sub)
      ) == 1L,
      .SD,
      .SDcols = sel,
      nomatch = nomatch
    ]
  )
}

ll <- list(
  a = letters[1:10],
  b = 1:10,
  c = letters[1:10],
  d = 1:10
)

times <- rbindlist(
  lapply(
    seq(from = 100000, to = 1000000, by = 25000),
    function(y){
      dat <- data.table(
        a = sample(letters, y, replace = T),
        b = sample.int(100, y, replace = T),
        c = sample(letters, y, replace = T),
        d = sample.int(100, y, replace = T)
      )
      return(
        rbindlist(
          lapply(
            2:4,
            function(x){
              return(
                setDT(
                  microbenchmark(
                    subsel(dat, sub = head(ll, x), sel = letters[2:4]),
                    subsel2(dat, sub = head(ll, x), sel = letters[2:4])
                  )
                )[, fields := x]
              )
            }
          )
        )[, size := y]
      )
    }
  )
)

times[
  ,
  expr2 := unlist(
    lapply(
      as.character(expr),
      function(x) unlist(strsplit(x, '(', fixed = T))[1]
    )
  )
]
times[
  ,
  expr2 := factor(
    expr2,
    levels = c('subsel', 'subsel2'),
    labels = c('CJ', 'pmin + Map + %in%')
  )
]

ggplot(times, aes(size, time, group = expr2, color = expr2)) +
  geom_smooth() +
  facet_grid(factor(fields) ~ .) +
  scale_y_continuous(labels = number_format(scale = 1e-6)) +
  labs(
    title = 'Execution Time by Fields to Subset on',
    x = 'Dataset Size',
    y = 'Time (Milliseconds)',
    color = 'Function'
  )

根据命名列表对data.table进行子设置

5 个答案: