基于列汇总变量的更快方法

Question

我希望根据一列总结我的数据框中的一些变量。但是，我的数据框相当大（> 30,000,000 行），并且在 dplyr 中使用汇总函数需要很长时间才能运行。 R中是否有更快的方法来加快总结过程？

我有一个格式为 df 的数据框：

  proid  X1  X2  X3 X4
1     1  zz   a   e  a
2     2  ff   g   z  b
3     1  cd   s   f  d 
4     3  ab   t   e  e
5     2  ta   b   h  k
      ....

当变量 X1 到 X4 具有相同的 prodid 值时，我希望将它们连接起来。连接的字符串用逗号分隔。所以上表应该给我新表：

  proid     X1   X2   X3  X4
1     1  zz,cd  a,s  e,f a,d 
2     2  ff,ta  g,b  z,h b,k
3     3     ab    t    e   e
      ....

我使用了以下 dplyr 代码：

concat <- function(x){
  x <- na.omit(x)
  if(length(x)==0){
    return(as.character(NA))
  }else{
    return(paste(x,collapse=","))
  }
}

dg<-group_by(df,proid)
df<-summarise(dg,proid,concat(X1),concat(X2),concat(X3),concat(X4))

Answer 1

na.omit 进行了大量不必要的检查和操作。用简单的is.na 调用替换它会给你一个不错的加速：

concat3 = function(x) {
  x = x[!is.na(x)]
  if (length(x) == 0)
    NA_character_
  else
    paste(x, collapse = ",")
}

使用 docendo 的数据（但使用字符串而不是因子 - 因子会减慢所有版本的速度）：

microbenchmark(dt[, lapply(.SD, concat3), by = proid, .SDcols = -c("X4")],
               dt[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")],
               times = 5)
#Unit: milliseconds
#                                                       expr       min       lq     mean   median       uq      max neval
# dt[, lapply(.SD, concat3), by = proid, .SDcols = -c("X4")]  960.2475 1079.177 1251.545 1342.684 1402.571 1473.045     5
# dt[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")] 1718.8121 1892.696 2159.148 2171.772 2470.205 2542.253     5

Answer 2

编辑说明：删除了我的答案中未解决 NA 处理的原始部分并添加了基准。

concat2 <- function(x) if(all(is.na(x))) NA_character_ else paste(na.omit(x), collapse = ",")

使用data.table：

setDT(df)[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")]
#   proid    X1  X2  X3
#1:     1 zz,cd a,s e,f
#2:     2 ff,ta g,b z,h
#3:     3    NA   t   e

使用 dplyr：

df %>% group_by(proid) %>% summarise_each(funs(concat2), -X4)

基准测试，数据比实际用例小，不完全具有代表性，所以只是想了解一下concat2 与concat 等的比较。

library(microbenchmark)
library(dplyr)
library(data.table)

N <- 1e6
x <- c(letters, LETTERS)
df <- data.frame(
  proid = sample(1e4, N, TRUE),
  X1 = sample(sample(c(x, NA), N, TRUE)),
  X2 = sample(sample(c(x, NA), N, TRUE)),
  X3 = sample(sample(c(x, NA), N, TRUE)),
  X4 = sample(sample(c(x, NA), N, TRUE))
  )

dt <- as.data.table(df)

concat <- function(x){
  x <- na.omit(x)
  if(length(x)==0){
    return(as.character(NA))
  }else{
    return(paste(x,collapse=","))
  }
}

concat2 <- function(x) if(all(is.na(x))) NA_character_ else paste(na.omit(x), collapse = ",")

concat.dplyr <- function(){
  df %>% group_by(proid) %>% summarise_each(funs(concat), -X4)
}

concat2.dplyr <- function(){
  df %>% group_by(proid) %>% summarise_each(funs(concat2), -X4)
}

concat.data.table <- function(){
  dt[, lapply(.SD, concat), by = proid, .SDcols = -c("X4")]
}

concat2.data.table <- function(){
  dt[, lapply(.SD, concat2), by = proid, .SDcols = -c("X4")]
}


microbenchmark(concat.dplyr(), 
               concat2.dplyr(), 
               concat.data.table(), 
               concat2.data.table(),
               unit = "relative",
               times = 10L)
Unit: relative
                 expr      min       lq   median       uq      max neval
       concat.dplyr() 1.058839 1.058342 1.083728 1.105907 1.080883    10
      concat2.dplyr() 1.057991 1.065566 1.109099 1.145657 1.079201    10
  concat.data.table() 1.024101 1.018443 1.093604 1.085254 1.066560    10
 concat2.data.table() 1.000000 1.000000 1.000000 1.000000 1.000000    10

发现：data.table 在样本数据上的执行速度比 dplyr 快一点，concat2 比 concat 快一点。然而，这个样本数据集的差异仍然很小。