一种选择是使用melt
将数据格式从"宽"转换为"长"。通过对'a'进行分组,我们使用paste
函数将与'value'中非零元素(在'i'中提供的逻辑条件)相对应的“变量”元素粘贴起来。
melt(df, id.var='a')[value!=0,
.(z=paste(variable, collapse="_")), keyby =a]
或者,我们可以按照“a”分组,对Data.table的子集(.SD
)进行unlist
操作,并paste
与非零元素对应的列的names
。
df[, {i1 <- !!unlist(.SD)
paste(names(.SD)[i1], collapse="_")} , by= a]
基准测试
set.seed(24)
df1 <- data.table(a=1:1e6, b = sample(0:5, 1e6,
replace=TRUE), c = sample(0:4, 1e6, replace=TRUE),
d = sample(0:3, 1e6, replace=TRUE))
akrun1 <- function() {
melt(df1, id.var='a')[value!=0,
.(z=paste(variable, collapse="_")), keyby =a]
}
akrun2 <- function() {
df1[, {i1 <- !!unlist(.SD)
paste(names(.SD)[i1], collapse="_")} , by= a]
}
ronak <- function() {
data.table(z = lapply(apply(df1, 1, function(x)
which(x[-1]!= 0)),
function(x) paste0(names(x), collapse = "_")))
}
eddi <- function(){
df1[, newcol := gsub("NA_|_NA|NA", "",
do.call(function(...) paste(..., sep = "_"),
Map(function(x, y) x[(y == 0) + 1], names(.SD), .SD)))
, .SDcols = b:d]
}
alexis = function(x)
{
ans = character(nrow(x))
for(j in seq_along(x)) {
i = x[[j]] > 0L
ans[i] = paste(ans[i], names(x)[[j]], sep = "_")
}
return(gsub("^_", "", ans))
}
system.time(akrun1())
system.time(akrun2())
system.time(ronak())
system.time(alexis(df1[, -1L, with = FALSE]))
system.time(eddi())
df[, ff(.SD), .SDcols = -1]
会表现得更好一些。 - David Arenburgdf [,.SDcols = -1, z:= ff(.SD)]
并避免深度复制,不像你原来的解决方案-因为with = FALSE
总是会进行深度复制。 - David Arenburg