在dplyr中确定分组数据框中最常见因子的最快方法

Question

我正在尝试在dplyr中对数据框进行汇总时查找多个因子变量中组内最常见的值。我需要一个能够完成以下任务的公式：

1. 在一组中，找到所有因子变量中最常用的因子级别（因子级别计数的“max()”）。
2. 如果有几个最常用的因子级别之间存在绑定，则选择其中任何一个因子级别。
3. 返回因子级别名称（不是计数的数量）。

有几个可行的公式可以实现这个功能。然而，我能想到的那些公式都很慢。而那些快速的公式又不方便同时适用于数据框中的多个变量。我想知道是否有人知道一种快速的方法，可以很好地集成到dplyr中。

我尝试了以下操作：

生成示例数据（50000组，每组包含100个随机字母）

z <- data.frame(a = rep(1:50000,100), b = sample(LETTERS, 5000000, replace = TRUE))

str(z)
'data.frame':   5000000 obs. of  2 variables:
$ a: int  1 2 3 4 5 6 7 8 9 10 ...
$ b: Factor w/ 26 levels "A","B","C","D",..: 6 4 14 12 3 19 17 19 15 20 ...

"清洁"-但较慢的方法 1

 y <- z %>% 
    group_by(a) %>% 
    summarise(c = names(table(b))[which.max(table(b))])

user    system  elapsed 
26.772  2.011   29.568 

"清洁"-但缓慢的方法2

y <- z %>% 
    group_by(a) %>% 
    summarise(c = names(which(table(b) == max(table(b)))[1]))

user    system  elapsed 
29.329  2.029   32.361 

"清洁"-但慢速方法 3

y <- z %>% 
    group_by(a) %>% 
    summarise(c = names(sort(table(b),decreasing = TRUE)[1]))

user    system  elapsed 
35.086  6.905   42.485 

"混乱但快速的方法"

y <- z %>% 
     group_by(a,b) %>% 
     summarise(counter = n()) %>% 
     group_by(a) %>% 
     filter(counter == max(counter))
y <- y[!duplicated(y$a),]
y <- y$counter <- NULL

user   system  elapsed 
7.061  0.330   7.664 

- Phil

Answer 1

这里有另一种使用dplyr的选项：

set.seed(123)
z <- data.frame(a = rep(1:50000,100), 
                b = sample(LETTERS, 5000000, replace = TRUE), 
                stringsAsFactors = FALSE)

a <- z %>% group_by(a, b) %>% summarise(c=n()) %>% filter(row_number(desc(c))==1) %>% .$b 
b <- z %>% group_by(a) %>% summarise(c=names(which(table(b) == max(table(b)))[1])) %>% .$c 

我们确保这些方法是等效的：

> identical(a, b)
#[1] TRUE

更新

正如@docendodiscimus所提到的，你也可以这样做：

count(z, a, b) %>% slice(which.max(n))

---

以下是基准测试的结果：

library(microbenchmark)
mbm <- microbenchmark(
  steven = z %>% group_by(a, b) %>% summarise(c = n()) %>% filter(row_number(desc(c))==1),
  phil = z %>% group_by(a) %>% summarise(c = names(which(table(b) == max(table(b)))[1])),
  docendo = count(z, a, b) %>% slice(which.max(n)),
  times = 10
)

#Unit: seconds
#    expr       min        lq      mean    median        uq       max neval cld
#  steven  4.752168  4.789564  4.815986  4.813686  4.847964  4.875109    10  b 
#    phil 15.356051 15.378914 15.467534 15.458844 15.533385 15.606690    10   c
# docendo  4.586096  4.611401  4.669375  4.688420  4.702352  4.753583    10 a 

- Steven Beaupré

---

你的代码可以简化为 count(z, a, b) %>% slice(which.max(n))。 - talat

Answer 2

为什么选择dplyr？

#dummy data
set.seed(123)
z <- data.frame(a = rep(1:50000,100),
                b = sample(LETTERS, 5000000, replace = TRUE))

#result
names(sort(table(z$b),decreasing = TRUE)[1])
# [1] "S"

#time it
system.time(
  names(sort(table(z$b),decreasing = TRUE)[1])
)

# user  system elapsed 
# 0.36    0.00    0.36 

编辑：多列

#dummy data
set.seed(123)
z <- data.frame(a = rep(1:50000,100),
                b = sample(LETTERS, 5000000, replace = TRUE),
                c = sample(LETTERS, 5000000, replace = TRUE),
                d = sample(LETTERS, 5000000, replace = TRUE))

# check for multiple columns
sapply(c("b","c","d"), function(i)
  names(sort(table(z[,i]),decreasing = TRUE)[1])
  )
# b   c   d 
#"S" "N" "G" 

#time it
system.time(
  sapply(c("b","c","d"), function(i)
    names(sort(table(z[,i]),decreasing = TRUE)[1]))
  )
# user  system elapsed 
# 0.61    0.17    0.78 

- zx8754

---

正如我所說，我需要對幾個不僅相互關聯而且綁定到一起的變量進行操作。如果我想要以這種方式完成，那麼我需要給每個變量分配一個ID並在最後合併它們。 - Phil

如果你有多列，请使用sapply将其包装起来，参见编辑。 - zx8754

很好。目前它只能给出每列的最高值。然而，我需要在"A"列的每一个独立的50000个组中找到最高值。你有办法扩展你的函数来实现这个吗？ - Phil

Answer 3

data.table 仍然是这方面最快的选择：

z <- data.frame(a = rep(1:50000,100), b = sample(LETTERS, 5000000, replace = TRUE))

基准测试：

library(data.table)
library(dplyr)

#dplyr
system.time({
  y <- z %>% 
    group_by(a) %>% 
    summarise(c = names(which(table(b) == max(table(b)))[1]))  
})
 user  system elapsed 
14.52    0.01   14.70 

#data.table
system.time(
  setDT(z)[, .N, by=b][order(N),][.N,]
)
 user  system elapsed 
 0.05    0.02    0.06 

#@zx8754 's way - base R
system.time(
  names(sort(table(z$b),decreasing = TRUE)[1])
)
   user  system elapsed 
   0.73    0.06    0.81 

使用data.table可以看到以下内容：

  setDT(z)[, .N, by=b][order(N),][.N,]

或者

  #just to get the name
  setDT(z)[, .N, by=b][order(N),][.N, b] 

似乎是最快的

更新所有列:

使用@zx8754的数据

set.seed(123)
z2 <- data.frame(a = rep(1:50000,100),
                b = sample(LETTERS, 5000000, replace = TRUE),
                c = sample(LETTERS, 5000000, replace = TRUE),
                d = sample(LETTERS, 5000000, replace = TRUE))

你可以这样做：

#with data.table
system.time(
 sapply(c('b','c','d'), function(x) {
  data.table(x = z2[[x]])[, .N, by=x][order(N),][.N, x] 
 }))
 user  system elapsed 
 0.34    0.00    0.34 

#with base-R
system.time(
  sapply(c("b","c","d"), function(i)
    names(sort(table(z2[,i]),decreasing = TRUE)[1]))
)
 user  system elapsed 
 4.14    0.11    4.26 

只是为了确认结果相同:

sapply(c('b','c','d'), function(x) {
  data.table(x = z2[[x]])[, .N, by=x][order(N),][.N, x] 
})
b c d 
S N G 

sapply(c("b","c","d"), function(i)
    names(sort(table(z2[,i]),decreasing = TRUE)[1]))
b   c   d 
"S" "N" "G" 

- LyzandeR

---

我认为你的编辑并没有返回正确的结果。 - David Arenburg

嗨，谢谢回复。我不熟悉data.table。它是否也返回每个组的值（因此对于具有相同列“a”中的值的值组，每个组都有50000个值）？如果是这样，请告诉我如何访问它？ - Phil

最好不要在行首使用 > 和 +，这样其他人可以更轻松地复制粘贴和重现。 - Frank

你觉得这样怎么样：“setDT(z)[, .N, by=.(a,b)][order(-N), .(b=b[1L]), keyby=a]”？ - Arun

谢谢@Arun。非常好的回答！ - LyzandeR

Answer 4

根据LyzandeR的建议，我将补充另一个答案：

require(data.table)
setDT(z)[, .N, by=.(a,b)][order(-N), .(b=b[1L]), keyby=a]

- Arun

---

这看起来非常不错。有没有一种方法可以使用sapply在一个调用中应用于几个变量？当我尝试sapply(c("b","c"), function(i) {setDT(z)[, .N, by=.(a,i)][order(-N), .(i = i[1L]), keyby=a]}时，我遇到了错误。 - Phil