创建一个新列,其中包含非空列的名称。

6

我的数据集看起来像这样:

library(data.table)

df <- data.table(a = c(1,2,3,4,5),
                 b = c(1,0,2,5,1),
                 c = c(0,1,1,0,0),
                 d = c(1,0,0,2,2))

df
#    a b c d
# 1: 1 1 0 1
# 2: 2 0 1 0
# 3: 3 2 1 0
# 4: 4 5 0 2
# 5: 5 1 0 2

我想创建一个非空列名的新列。结果将是:
df_result <- data.table(a = c(1,2,3,4,5),
                        z = c('b_d', 'c', 'b_c', 'b_d', 'b_d'))

df_result
#    a   z
# 1: 1 b_d
# 2: 2   c
# 3: 3 b_c
# 4: 4 b_d
# 5: 5 b_d
4个回答

12

假设 nrow >> ncol,您可以按列进行操作

ff = 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))
}
ff(df[, -1L, with = FALSE]) #or, `df[, ff(.SD), .SDcols = -1L]` from David Arenburg
#[1] "b_d" "c"   "b_c" "b_d" "b_d"

1
哦,这很好。我一直在等你发布一些东西。我猜 df[, ff(.SD), .SDcols = -1] 会表现得更好一些。 - David Arenburg
@DavidArenburg:我看到了“data.table”标签上的流量,试图挤出一些赞……我也对你的想法进行了基准测试,两者的性能似乎相似。 - alexis_laz
2
是的,但是你可以像这样做 df [,.SDcols = -1, z:= ff(.SD)] 并避免深度复制,不像你原来的解决方案-因为 with = FALSE 总是会进行深度复制。 - David Arenburg

8

一种选择是使用melt将数据格式从"宽"转换为"长"。通过对'a'进行分组,我们使用paste函数将与'value'中非零元素(在'i'中提供的逻辑条件)相对应的“变量”元素粘贴起来。

melt(df, id.var='a')[value!=0, 
      .(z=paste(variable, collapse="_")), keyby =a]
#   a   z
#1: 1 b_d
#2: 2   c
#3: 3 b_c
#4: 4 b_d
#5: 5 b_d

或者,我们可以按照“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())
#   user  system elapsed 
#  22.04    0.15   22.36 
 system.time(akrun2())
#   user  system elapsed 
# 26.33    0.00   26.41 
 system.time(ronak())
#   user  system elapsed 
#  25.60    0.26   25.96 


system.time(alexis(df1[, -1L, with = FALSE]))
#   user  system elapsed 
#   1.92    0.06    2.09 

system.time(eddi())
#  user  system elapsed 
#   2.41    0.06    3.19 

是的,这两个解决方案在我的机器上运行了将近2分钟,使用1e7数据集。apply解决方案的运行时间并不长。 - David Arenburg
为什么不用 keyby=a - jangorecki
是的,apply 运行时间大约比另一个长20-30秒。 - David Arenburg
3
@akrun请也为另外两个答案添加基准测试。 - eddi
2
@akrun 嗯,好的,如果我有任何这样做的欲望,早就完成了。你可以改进你的答案,因为它目前包含了最慢答案的基准,并省略了两个更快的答案。 - eddi
显示剩余4条评论

8

以下是一种直接的方法:

df[, newcol := gsub("NA_|_NA|NA", "",                           # remove unwanted text
       do.call(function(...) paste(..., sep = "_"),             # paste colnames together
         Map(function(x, y) x[(y == 0) + 1], names(.SD), .SD))) # convert data to colnames
   , .SDcols = b:d]
#   a b c d newcol
#1: 1 1 0 1    b_d
#2: 2 0 1 0      c
#3: 3 2 1 0    b_c
#4: 4 5 0 2    b_d
#5: 5 1 0 2    b_d

在akrun的测试数据上,速度比原来快了10倍以上。

4

这可能会有点冗长。

对于每一行,找到一个值不为0的列,然后将列名拼接在一起。

data.table(a= df$a, z = lapply(apply(df, 1, 
           function(x) which(x[-1]!= 0)), 
           function(x) paste0(names(x), collapse = "_")))


#   a   z
#1: 1 b_d
#2: 2   c
#3: 3 b_c
#4: 4 b_d
#5: 5 b_d

1
这只是将 data.table 转换为矩阵并通过行操作执行的过程。在此解决方案中与 data.table 无关。 - David Arenburg
问题下的标签在这里是相关的。 - Roland
2
你在5行上进行了基准测试吗? - David Arenburg
@jangorecki 我认为获取z列更重要。无论如何,追求完美没有坏处。谢谢。已更新! - Ronak Shah
2
@RonakShah 那基准测试呢?仅对 5 行显示基准测试毫无意义 :/ - jangorecki
显示剩余2条评论

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接