通过 data.table 或 dplyr 中的分组列为每个数字列选择最大绝对值答案

【问题标题】：Select max of absolute value for each numeric column by a grouping column in data.table or dplyr通过 data.table 或 dplyr 中的分组列为每个数字列选择最大绝对值
【发布时间】：2016-04-14 23:40:24
【问题描述】：

这是我的 data.frame 的示例：

opts <- seq(-0.5, 0.5, 0.05)
df <- data.frame(combo1=sample(opts, 6),
                 combo2=sample(opts, 6),
                 combo3=sample(opts, 6),
                 gene=rep(c("g1", "g2", "g3"), each=2), stringsAsFactors=F)

df
   combo1 combo2 combo3 gene
1   0.40   0.50  -0.10   g1
2   0.10  -0.20  -0.35   g1
3  -0.35  -0.35   0.40   g2
4   0.00   0.10  -0.30   g2
5  -0.45  -0.10   0.05   g3
6  -0.40  -0.40  -0.05   g3

对于每个组合，我想按基因分组，然后选择最大绝对值。我可以使用 dplyr 完成此操作：

library(dplyr)
df_final <- data.frame(row.names=unique(df$gene))

for (combo in colnames(df)[1:3]) {

    combo_preds <- df[, c(combo, "gene")]
    colnames(combo_preds) <- c("pred", "gene")

    combo_preds %>%
        group_by(gene) %>%
        arrange(desc(abs(pred))) %>%
        slice(1) %>%
        ungroup() ->
        combo_preds

    #add to df_final
    class(combo_preds) <- "data.frame"
    df_final[combo_preds$gene, combo] <- combo_preds$pred
}
#names rows based on gene
row.names(df_final) <- unique(df$gene)

df_final
    combo1 combo2 combo3
g1   0.40   0.50  -0.35
g2  -0.35  -0.35   0.40
g3  -0.45  -0.40   0.05

有没有一种方法可以通过 data.table 或其他更有效的实现来完成上述任务？实际上，我有 ~1300 个 dfs，每个都有 ~14000 个基因和 ~650 个组合。当前实现每个 df 需要 2.6 分钟，因此需要 2 天以上。

【问题讨论】：

在制作随机示例数据集之前，您可能希望使用set.seed。

标签： r data.table dplyr

【解决方案1】：

您当然可以使用data.table。（我没有针对您的版本进行基准测试）。

library(data.table)
dt <- data.table(df)
dt[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']

它本质上是按基因对表格进行分组，并且在表格的每一块上使用lapply 循环遍历每一列以找到具有最大绝对值的值。

但是，我认为您最好将表格重新调整为长格式，尽管我认为这取决于您的具体数据（您必须尝试看看）。

opts <- seq(-0.5, 0.5, 0.05)
n.combos <- 600
n.genes <- 10000
n.rows.per.gene <- 5

# columns are called X1 X2 instead of combo1 combo2 but no matter.
df.wide <- data.frame(replicate(n.combos, sample(opts, n.rows.per.gene, replace=T)),
                      gene=rep(paste0("g", 1:n.genes), each=n.rows.per.gene))

这里的df.wide 看起来像您的数据框，每个组合一列，每个基因的每个复制一行。

这是data.table的原始答案：

# data.table option
library(data.table)
dt <- data.table(df.wide)
system.time({
out <- dt[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']
})
#    user  system elapsed 
#  10.757   0.364  12.612

现在我们重塑为长格式，它只有一个“组合”列和一个“值”列：

# reshape to long
dt.long <- melt(dt, id.vars='gene', variable.name='combo')
# > head(dt.long)
#    gene combo value
# 1:   g1    X1  0.20
# 2:   g1    X1  0.30
# 3:   g1    X1  0.10
# 4:   g1    X1  0.05
# 5:   g1    X1  0.30
# 6:   g2    X1  0.20

system.time({out.long <- dt.long[, value[which.max(value)], by='gene,combo']})

   user  system elapsed 
  8.000   0.472   9.525

这为您提供了一个数据框，其中包含最大绝对值的基因、组合和值。如果您愿意，您可以将其重新调整为宽。

所以它看起来并没有快多少 - 我想你将不得不在你的数据上尝试它并查看。我想即使第二种方法更快，您仍然必须考虑将数据表转换为 long 所花费的时间（这似乎并不多）。

比较例如dplyr（使用起来非常优雅，但速度较慢）

system.time({
out.dplyr <- df.wide %>% group_by(gene) %>%
  summarise_each(funs(.[which.max(abs(.))]))
})
#   user  system elapsed 
# 163.106   7.989 189.788

【讨论】：

【解决方案2】：

这里有一个更简单更快的dplyr 方法：

df %>% group_by(gene) %>%
  summarise_each(funs(.[which.max(abs(.))]))

在可重现的数据上试一试：

set.seed(495)
opts <- seq(-0.5, 0.5, 0.05)
df <- data.frame(combo1=sample(opts, 6),
                 combo2=sample(opts, 6),
                 combo3=sample(opts, 6),
                 gene=rep(c("g1", "g2", "g3"), each=2), stringsAsFactors=F)

df

  combo1 combo2 combo3 gene
1  -0.15   0.50  -0.25   g1
2  -0.45  -0.50   0.15   g1
3  -0.25   0.10  -0.30   g2
4   0.35  -0.40  -0.15   g2
5  -0.05  -0.35  -0.40   g3
6   0.15  -0.05  -0.10   g3

df %>% group_by(gene) %>%
  summarise_each(funs(.[which.max(abs(.))]))

   gene combo1 combo2 combo3
1    g1  -0.45   0.50  -0.25
2    g2   0.35  -0.40  -0.30
3    g3   0.15  -0.35  -0.40

请注意，在上述情况下，combo2 和 gene=g1 的绝对值是相同的。如果这很重要，您将需要决定如何打破关系。

我的dplyr 方法和@mathematical.coffee 的data.table 方法的稍快版本的时间安排（使用更大的样本数据框）：

set.seed(495)
opts <- seq(-0.5, 0.5, 0.05)
df <- data.frame(combo1=sample(opts, 9e4, replace=TRUE),
                 combo2=sample(opts, 9e4, replace=TRUE),
                 combo3=sample(opts, 9e4, replace=TRUE),
                 gene=rep(c("g1", "g2", "g3"), each=3e4), stringsAsFactors=F)

microbenchmark::microbenchmark(
  dplyr=setDF(df) %>% group_by(gene) %>%
    summarise_each(funs(.[which.max(abs(.))])),
  data.table={setDT(df)[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']}
)

Unit: milliseconds
      expr       min        lq      mean    median        uq      max neval cld
     dplyr 10.013623 11.839132 14.156735 12.284574 12.675220 32.35739   100   b
data.table  4.434841  6.008701  6.947104  6.222775  6.415083 29.52652   100  a

所以data.table 版本的运行时间大约是dplyr 版本的一半。

更新：为了解决@Arun 的评论，这里有一个更大的示例数据框，其中包含更多列和更多gene 类别。

# Large sample of fake data
set.seed(194)
genes=apply(expand.grid(letters,letters), 1, paste, collapse="")
df = data.frame(replicate(50, rnorm(26*26*1e3)), gene=genes)
object.size(df)
# 273 MB

microbenchmark::microbenchmark(
  dplyr=setDF(df) %>% group_by(gene) %>%
    summarise_each(funs(.[which.max(abs(.))])),
  data.table={setDT(df)[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']},
  times=10
)

Unit: milliseconds
      expr       min        lq      mean    median        uq       max neval cld
     dplyr 1240.1695 1299.0425 1375.8298 1318.5343 1385.5854 1748.8112    10   b
data.table  464.5597  493.8959  527.7097  519.3607  585.1482  603.3916    10  a

更新 2： 与上面相同，但组数更大（26^3 而不是 26^2）。正如@Arun 所讨论的，data.table 的速度优势会随着组数的增加而增加。

   # Large sample of fake data
   set.seed(194)
   genes=apply(expand.grid(letters,letters,letters), 1, paste, collapse="")
   df = data.frame(replicate(50, rnorm(26*26*26*50)), gene=genes)
   object.size(df)
   # 356 MB

   microbenchmark::microbenchmark(
     dplyr=setDF(df) %>% group_by(gene) %>%
       summarise_each(funs(.[which.max(abs(.))])),
     data.table={setDT(df)[, lapply(.SD, function (col) col[which.max(abs(col))]), by='gene']},
     times=1
   )

   Unit: seconds
             expr       min        lq      mean    median        uq       max neval
            dplyr 27.567790 27.567790 27.567790 27.567790 27.567790 27.567790     1        
       data.table  2.765047  2.765047  2.765047  2.765047  2.765047  2.765047     1

【讨论】：

您的基准数据大小为 2.7MB（甚至完全适合缓存），而 math.coffee 的大小约为 230MB。如果没有合理大小的数据，很难了解工具的性能/扩展程度。我认为这也是因为他/她的数据集有很多列。而dplyr单独评估每一列（以便您可以直接在其中引用前一列），只要函数针对混合评估进行了优化，这很好，但否则效率很低。跨度>
比原始方法更好看的代码，但由于某种原因慢了大约一分钟（2.62 分钟对 3.53 分钟）。相比之下，@mathematical.coffee 的 data.table 方法在 42 秒内完成。
@eipi10，感谢您的跟进。不完全，但好多了。它有助于更好地理解性能差异的原因。谢谢。

【解决方案3】：

基础 R 中的一种可行的方法（还有很多其他方法）

# for max absolute value, build a function
maxAbsObs <- function(x) x[which.max(abs(x))]


aggregate(df[,grep("combo", names(df))], list(df$gene), maxAbsObs)

这里有一个data.table的方法来按基因选择每个combo的最大绝对值：

library(data.table)
setDT(df)
df[, lapply(.SD, maxAbsObs), by="gene"]

【讨论】：

不，这是正确的，除了 OP 想要最大 absolute 值而不是最大值。

【解决方案4】：

@mathematical.coffee 的回答对 lapply 来说非常好，但是还有一种更多的 data.table 方法可以实现相同的目标：

opts <- seq(-0.5, 0.5, 0.05)
dt <- data.table(combo1=sample(opts, 6),
                 combo2=sample(opts, 6),
                 combo3=sample(opts, 6),
                 gene=rep(c("g1", "g2", "g3"), each=2))

dt

   combo1 combo2 combo3 gene 
1:  -0.20  -0.40  -0.10   g1 
2:   0.15   0.15   0.40   g1 
3:   0.35   0.10  -0.05   g2 
4:   0.45  -0.15  -0.25   g2 
5:   0.00  -0.25   0.50   g3 
6:   0.10   0.20   0.25   g3

dt2 <- dt[, .(combo1=max(combo1), combo2=max(combo2), combo3=max(combo3)), 
            keyby=gene]

dt2

   gene combo1 combo2 combo3
1:   g1   0.15   0.15   0.40
2:   g2   0.45   0.10  -0.05
3:   g3   0.10   0.20   0.50

晚了，但希望这对其他人有帮助:(

【讨论】：