我有一个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)
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...
（这很慢，导致问题......）
R中执行此操作的最快方法是什么？dplyr / data.table /其他更快的方法？Rcpp？是否可以在适当的位置修改列修改，而不是复制lapply(vars,setdiff(...结果？
如果必须是单独的步骤，那么过滤掉vars == character(0)的最有效方法是什么。
答案 0 :(得分：8)
不考虑任何算法改进，类似的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
答案 1 :(得分：8)
这是另一种方式：
# 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()和{{1}在hannahh()增长时击败它。
重复执行此操作的基准。这可能是显而易见的，但如果您必须“多次”执行此操作（...有多少很难说），最好创建密钥列，而不是每组nobs的子集。在上面的模拟中，baduns的速度约为eddi()的5倍，所以如果我做了10次以上的子集化，我会选择后者。
frank()因此，正如预期的那样，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()线性增长。
答案 2 :(得分：1)
这是另一个想法：
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解决方案。