在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"

我想根据过滤data.frame setdiff(vars,remove_this)

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 /延伸:

• 是否可以通过复制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

您也可以删除原始列(基本上是0成本),[, vars := NULL]最后添加).或者,如果您不需要该信息,则可以简单地覆盖初始列,即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(),它有时缩小,有时保持不变.在最好的nobs = 1e5情况下frank(),eddi()仍然快3倍.

如果我们从一个valset字符切换到一个frank()必须强制转换为一个字符进行逐行paste0操作的东西eddi(),hannahh()那么它们都会nobs变长.

反复这样做的基准.这可能是显而易见的,但是如果你必须"多次"执行此操作(...有多少很难说),那么创建关键列比为每组设置子集更好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()线性增长.