r - 在一轮中将 tstrsplit 拆分为不同的列

Question

我有一张如下表:

myDT <- fread(
  "id,other,strformat,content
 1, other1, A:B,    a1:b1
 2, other2, A:C,    a2:c2
 3, other3, B:A:C,  b3:a3:c3
 4, other4, A:B,    a4:b4
 5, other5, XX:whatever,    xx5:whatever5
")

我想拆分 content列基于 strformat ，得到这个:

   id  other   strformat       content    A    B    C   XX  whatever
1:  1 other1         A:B         a1:b1   a1   b1 <NA> <NA>      <NA>
2:  2 other2         A:C         a2:c2   a2 <NA>   c2 <NA>      <NA>
3:  3 other3       B:A:C      b3:a3:c3   a3   b3   c3 <NA>      <NA>
4:  4 other4         A:B         a4:b4   a4   b4 <NA> <NA>      <NA>
5:  5 other5 XX:whatever xx5:whatever5 <NA> <NA> <NA>  xx5 whatever5

我失败了 tstrsplit()在 by= :

myDT[, unlist(strsplit(strformat,':')):=tstrsplit(content,':'), by=strformat]
# Error in strsplit(strformat, ":") : object 'strformat' not found

所以现在我求助于使用循环:

for (this.format in unique(myDT$strformat)){
  myDT[strformat==this.format, unlist(strsplit(this.format,':')):=tstrsplit(content,':')]
}

它可以完成这项工作，但我仍然想知道 by= 的正确方法是什么？

Answer 1

因此，我测试了@akrun 建议的 3 种解决方案，并稍作修改。跳过最后一个，因为它具有硬编码的列名。

# define functions to compare:

require(splitstackshape)
f_csplit <- function(inpDT, col_format='strformat', col_content='content', sep=':'){
  invisible(inpDT[dcast(
    cSplit(inpDT, c(col_format, col_content), sep, "long"), 
    as.formula(paste('id',col_format,sep='~')), 
    value.var=col_content
  ), , on = .(id)])
}

f_lapply_str <- function(inpDT, col_format='strformat', col_content='content', sep=':'){
  invisible(inpDT[dcast(
    inpDT[, unlist(lapply(.SD, strsplit, sep), recursive = FALSE), by = id, .SDcols = 2:3], 
    as.formula(paste('id',col_format,sep='~')),
    value.var=col_content
  ), on = .(id)])
}

require(tidyverse)
f_unnest <- function(inpDT, col_format='strformat', col_content='content', sep=':'){
  invisible(inpDT[dcast(
    unnest(inpDT[, lapply(.SD, tstrsplit, sep),by = id, .SDcols = 2:3]), 
    as.formula(paste('id',col_format,sep='~')), 
    value.var=col_content
  ), on = .(id)])
}

f_cycle <- function(inpDT, col_format='strformat', col_content='content', sep=':'){
  inpDT <- copy(inpDT); # in fact I don't even need to make a copy:
                        # := modifies the original table which is fine for me - 
                        # but for benchmarking let's make a copy  
  for (this.format in unique(inpDT[[col_format]])){
    inpDT[get(col_format)==this.format, unlist(strsplit(this.format,sep)):=tstrsplit(get(col_content),sep)]
  }
  invisible(inpDT)
}

似乎解决方案 #2( lapply 的 strsplit ，没有 cSplit )和#3( unnest) 当我在表中有任何其他列时无法正常工作，它只有在我删除“其他”:

myDT[dcast(myDT[, unlist(lapply(.SD, strsplit, ":"), recursive = FALSE), by = id, .SDcols = 2:3], id ~ strformat), on = .(id)]
#      id  other   strformat       content    A    B    C   XX whatever
#   1:  1 other1         A:B         a1:b1    A    B <NA> <NA>     <NA>
#   2:  2 other2         A:C         a2:c2    A <NA>    C <NA>     <NA>
#   3:  3 other3       B:A:C      b3:a3:c3    A    B    C <NA>     <NA>
#   4:  4 other4         A:B         a4:b4    A    B <NA> <NA>     <NA>
#   5:  5 other5 XX:whatever xx5:whatever5 <NA> <NA> <NA>   XX whatever

myDT[dcast(unnest(myDT[, lapply(.SD, tstrsplit, ":"),by = id, .SDcols = 2:3]), id ~ strformat), on = .(id)]
# (same result as above)

myDT$other <- NULL
myDT[dcast(myDT[, unlist(lapply(.SD, strsplit, ":"), recursive = FALSE), by = id, .SDcols = 2:3], id ~ strformat), on = .(id)]
#      id   strformat       content    A    B    C   XX  whatever
#   1:  1         A:B         a1:b1   a1   b1 <NA> <NA>      <NA>
#   2:  2         A:C         a2:c2   a2 <NA>   c2 <NA>      <NA>
#   3:  3       B:A:C      b3:a3:c3   a3   b3   c3 <NA>      <NA>
#   4:  4         A:B         a4:b4   a4   b4 <NA> <NA>      <NA>
#   5:  5 XX:whatever xx5:whatever5 <NA> <NA> <NA>  xx5 whatever5

myDT[dcast(unnest(myDT[, lapply(.SD, tstrsplit, ":"),by = id, .SDcols = 2:3]), id ~ strformat), on = .(id)]
# (same correct result as above)

这是删除“其他”列的基准测试:

# make a bigger table based on a small one:
myDTbig <- myDT[sample(nrow(myDT),1e5, replace = T),]
myDTbig[, id:=seq_len(nrow(myDTbig))]
myDTbig$other <- NULL

require(microbenchmark)
print(microbenchmark(
  f_csplit(myDTbig), 
  f_lapply_str(myDTbig), 
  f_unnest(myDTbig), 
  f_cycle(myDTbig), 
  times=10L
), signif=2)

# Unit: milliseconds
#              expr      min   lq mean median   uq  max neval
# f_csplit(myDTbig)      420  430  470    440  450  670    10
# f_lapply_str(myDTbig) 4200 4300 4700   4700 5100 5400    10
# f_unnest(myDTbig)     3900 4400 4500   4500 4800 5100    10
# f_cycle(myDTbig)        88   96   98     98  100  100    10

并保留“其他”列:

# make a bigger table based on a small one:
myDTbig <- myDT[sample(nrow(myDT),1e5, replace = T),]
myDTbig[, id:=seq_len(nrow(myDTbig))]

require(microbenchmark)
print(microbenchmark(
  f_csplit(myDTbig), 
  f_cycle(myDTbig), 
  times=100L
), signif=2)

# Unit: milliseconds
#              expr min  lq mean median  uq  max neval
# f_csplit(myDTbig) 410 440  500    460 490 1300   100
# f_cycle(myDTbig)   84  93  110     96 100  270   100

下面是我的真实数据集。嗯，实际上，只有它的 1/10:使用完整的我在 csplit 上出现内存分配错误解决方案(而具​​有循环的那个工作正常)。

myDTbig <- dt.vcf[1:2e6,]
myDTbig[,id:=seq_len(nrow(myDTbig))]

print(microbenchmark(
  f_csplit(myDTbig, 'FORMAT', 'S_1'), 
  f_cycle(myDTbig, 'FORMAT', 'S_1'), 
  times=5L
), signif=2)
# Unit: seconds
#                              expr  min   lq mean median   uq  max neval
# f_csplit(myDTbig, "FORMAT", "S_1") 15.0 16.0   16   16.0 16.0 17.0     5
# f_cycle(myDTbig, "FORMAT", "S_1")   4.9  4.9    6    5.7  5.8  8.5     5

最后，我测试了 format 中是否有多个级别列(即我们必须运行多少个周期)将随着周期增加解决方案的时间:

myDTbig <- myDT[sample(nrow(myDT),1e6, replace = T),]
myDTbig[, strformat:=paste0(strformat,sample(letters,1e6, replace = T)),]
length(unique(myDTbig$strformat)) # 104
myDTbig[, id:=seq_len(nrow(myDTbig))]

print(microbenchmark(
  f_csplit(myDTbig), 
  f_cycle(myDTbig), 
  times=10L
), signif=2)
# Unit: seconds
#             expr  min  lq mean median  uq max neval
# f_csplit(myDTbig) 7.3 7.4  7.7    7.6 7.9 8.4    10
#  f_cycle(myDTbig) 2.7 2.9  3.0    2.9 3.0 3.8    10

因此，作为一个结论 - 令人惊讶的是，对于这项任务，该循环的表现比其他任何东西都要好。