在 R/Rcpp 中过滤 data.frame 列表列内容的最快方法

Question

我有一个 data.frame:

df <- structure(list(id = 1:3, vars = list("a", c("a", "b", "c"), c("b", 
"c"))), .Names = c("id", "vars"), row.names = c(NA, -3L), class = "data.frame")

有一个列表列（每个列都有一个字符向量）：

> str(df)
'data.frame':   3 obs. of  2 variables:
     $ id  : int  1 2 3
     $ vars:List of 3
      ..$ : chr "a"
      ..$ : chr  "a" "b" "c"
      ..$ : chr  "b" "c"

我想根据setdiff(vars,remove_this)

过滤data.frame

library(dplyr)
library(tidyr)
res <- df %>% mutate(vars = lapply(df$vars, setdiff, "a"))

这让我明白了：

   > res
      id vars
    1  1     
    2  2 b, c
    3  3 b, c

但是要删除 character(0) 变量，我必须执行以下操作：

res %>% unnest(vars) # and then do the equivalent of nest(vars) again after...

实际数据集：

560K 行和 3800K 行，还有 10 列（携带）。

（这个速度很慢，引来质疑...）

在 `R` 中执行此操作的最快方法是什么？

有没有dplyr/data.table/其他更快的方法？
如何使用 Rcpp 执行此操作？

UPDATE/EXTENSION:

是否可以就地修改列而不是通过复制 lapply(vars,setdiff(... 结果？
如果必须是一个单独的步骤，那么过滤掉vars == character(0)的最有效方法是什么。

Answer 1

抛开任何算法改进，类似的 data.table 解决方案会自动变得更快，因为您不必为了添加一列而复制整个内容：

library(data.table)
dt = as.data.table(df)  # or use setDT to convert in place

dt[, newcol := lapply(vars, setdiff, 'a')][sapply(newcol, length) != 0]
#   id  vars newcol
#1:  2 a,b,c    b,c
#2:  3   b,c    b,c

您也可以通过在末尾添加[, vars := NULL]来删除原始列（成本基本为0）。或者，如果您不需要该信息，您可以简单地覆盖初始列，即 dt[, vars := lapply(vars, setdiff, 'a')].

现在就算法改进而言，假设您的 id 值对于每个 vars 都是唯一的（如果不是，请添加一个新的唯一标识符），我认为这会更快并且自动负责过滤：

dt[, unlist(vars), by = id][!V1 %in% 'a', .(vars = list(V1)), by = id]
#   id vars
#1:  2  b,c
#2:  3  b,c

为了继承其他专栏，我认为简单地合并回去是最简单的：

dt[, othercol := 5:7]

# notice the keyby
dt[, unlist(vars), by = id][!V1 %in% 'a', .(vars = list(V1)), keyby = id][dt, nomatch = 0]
#   id vars i.vars othercol
#1:  2  b,c  a,b,c        6
#2:  3  b,c    b,c        7

Answer 2

这是另一种方式：

# prep
DT <- data.table(df)
DT[,vstr:=paste0(sort(unlist(vars)),collapse="_"),by=1:nrow(DT)]
setkey(DT,vstr)

get_badkeys <- function(x) 
  unlist(sapply(1:length(x),function(n) combn(sort(x),n,paste0,collapse="_")))

# choose values to exclude
baduns  <- c("a","b")

# subset
DT[!J(get_badkeys(baduns))]

这相当快，但是它占用了你的key。

基准。这是一个虚构的例子：

考生：

hannahh <- function(df,baduns){
    df %>% 
        mutate(vars = lapply(.$vars, setdiff, baduns)) %>% 
        filter(!!sapply(vars,length))
}
eddi    <- function(df,baduns){
        dt = as.data.table(df)
        dt[, 
          unlist(vars)
        , by = id][!V1 %in% baduns, 
          .(vars = list(V1))
        , keyby = id][dt, nomatch = 0]
}   
stevenb <- function(df,baduns){
    df %>% 
      rowwise() %>% 
      do(id = .$id, vars = .$vars, newcol = setdiff(.$vars, baduns)) %>%
      mutate(length = length(newcol)) %>%
      ungroup() %>%
      filter(length > 0)
}
frank   <- function(df,baduns){
    DT <- data.table(df)
    DT[,vstr:=paste0(sort(unlist(vars)),collapse="_"),by=1:nrow(DT)]
    setkey(DT,vstr)
    DT[!J(get_badkeys(baduns))]
}

模拟：

nvals  <- 4
nbads  <- 2
maxlen <- 4

nobs   <- 1e4

exdf   <- data.table(
  id=1:nobs,
  vars=replicate(nobs,list(sample(valset,sample(maxlen,1))))
)
setDF(exdf)
baduns <- valset[1:nbads]

结果：

system.time(frank_res   <- frank(exdf,baduns))
#   user  system elapsed 
#   0.24    0.00    0.28 
system.time(hannahh_res <- hannahh(exdf,baduns))
#   0.42    0.00    0.42
system.time(eddi_res    <- eddi(exdf,baduns))
#   0.05    0.00    0.04
system.time(stevenb_res <- stevenb(exdf,baduns))
#   36.27   55.36   93.98

检查：

identical(sort(frank_res$id),eddi_res$id) # TRUE
identical(unlist(stevenb_res$id),eddi_res$id) # TRUE
identical(unlist(hannahh_res$id),eddi_res$id) # TRUE

讨论：

对于eddi()和hannahh()，nvals、nbads和maxlen的结果几乎没有变化。相反，当 baduns 超过 20 时，frank() 变得非常慢（比如 20+ 秒）；它也随着 nbads 和 maxlen 比其他两个差一点。

扩大 nobs，eddi() 对 hannahh() 的领先优势保持不变，约为 10 倍。反对 frank()，它有时会缩小，有时会保持不变。在 frank() 的最佳 nobs = 1e5 情况下，eddi() 仍然快 3 倍。

如果我们从 valset 个字符切换到 frank() 必须强制转换为行 paste0 操作的字符，eddi() 和 hannahh() 随着 nobs 的增长击败它。

重复执行此操作的基准。 这可能是显而易见的，但如果您必须执行此操作 "many" 次（...很难说多少次） , 最好创建键列而不是为每个 baduns 集进行子集化。在上面的模拟中，eddi() 大约是 frank() 的 5 倍，所以如果我做这个子集 10 次以上，我会选择后者。

maxbadlen    <- 2
set_o_baduns <- replicate(10,sample(valset,size=sample(maxbadlen,1)))

system.time({
    DT <- data.table(exdf)
    DT[,vstr:=paste0(sort(unlist(vars)),collapse="_"),by=1:nrow(DT)]
    setkey(DT,vstr)

    for (i in 1:10) DT[!J(get_badkeys(set_o_baduns[[i]]))]
})
# user  system elapsed 
# 0.29    0.00    0.29

system.time({
    dt = as.data.table(exdf)
    for (i in 1:10) dt[, 
      unlist(vars), by = id][!V1 %in% set_o_baduns[[i]],
      .(vars = list(V1)), keyby = id][dt, nomatch = 0]
})
# user  system elapsed 
# 0.39    0.00    0.39

system.time({
    for (i in 1:10) hannahh(exdf,set_o_baduns[[i]])
})
# user  system elapsed 
# 4.10    0.00    4.13

因此，正如预期的那样，frank() 花费很少的时间进行额外评估，而 eddi() 和 hannahh() 呈线性增长。

Answer 3

这是另一个想法：

df %>% 
  rowwise() %>% 
  do(id = .$id, vars = .$vars, newcol = setdiff(.$vars, "a")) %>%
  mutate(length = length(newcol)) %>%
  ungroup()

给出：

#  id    vars newcol length
#1  1       a             0
#2  2 a, b, c   b, c      2
#3  3    b, c   b, c      2

然后您可以过滤 length > 0 以仅保留非空 newcol

df %>% 
  rowwise() %>% 
  do(id = .$id, vars = .$vars, newcol = setdiff(.$vars, "a")) %>%
  mutate(length = length(newcol)) %>%
  ungroup() %>%
  filter(length > 0)

给出：

#  id    vars newcol length
#1  2 a, b, c   b, c      2
#2  3    b, c   b, c      2

注意：正如@Arun 在评论中提到的，这种方法很慢。 data.table 解决方案会让你过得更好。

在 R/Rcpp 中过滤 data.frame 列表列内容的最快方法

Fastest way to filter a data.frame list column contents in R / Rcpp

r

performance

data.table

dplyr

rcpp

实际数据集：

在 `R` 中执行此操作的最快方法是什么？

UPDATE/EXTENSION:

在 R/Rcpp 中过滤 data.frame 列表列内容的最快方法

Fastest way to filter a data.frame list column contents in R / Rcpp

r

performance

data.table

dplyr

rcpp

实际数据集：

在 R 中执行此操作的最快方法是什么？

UPDATE/EXTENSION:

在 `R` 中执行此操作的最快方法是什么？