以有效的方式按組生成包含所有組合計數的表

Question

我有以下數據集示例：

df <- tibble(group = c(rep(1, 6), rep(2, 6)),
             class1 = c("A", "A", "B", "B", "B", "C", "B", "B", "B", "C", "C", "C"),
             class2 = c("A", "B", "B", "B", "C", "B", "B", "B", "A", "C", "A", "B"))
df

我想以快速的方式按group制作一個包含class1和class2之間所有組合的表格。

我嘗試了下面的代碼，但是對於我的數據來說它非常慢（大於 1000 萬行）。 需要30多分鍾。

output <- df %>% table() %>% as.data.table()

output 需要：

output <- tibble(group = c(rep(1, 9), rep(1, 9)),
                 class1 = c(rep("A", 3), rep("B", 3), rep("C", 3),
                            rep("A", 3), rep("B", 3), rep("C", 3)),
                 class2 = rep(c("A", "B", "C"), 6),
                 N = c(1, 1, 0, 0, 2, 1, 0, 1, 0, 0, 0, 0, 1, 2, 0, 1, 1, 1))
output

謝謝你的幫助

Answer 1

這是否有效：

library(dplyr)
library(tidyr)

df %>% mutate(N = 1) %>% complete( group, class1, class2) %>% 
                distinct() %>% mutate(N = replace_na(N, 0))
# A tibble: 18 × 4
   group class1 class2     N
   <dbl> <chr>  <chr>  <dbl>
 1     1 A      A          1
 2     1 A      B          1
 3     1 A      C          0
 4     1 B      A          0
 5     1 B      B          1
 6     1 B      C          1
 7     1 C      A          0
 8     1 C      B          1
 9     1 C      C          0
10     2 A      A          0
11     2 A      B          0
12     2 A      C          0
13     2 B      A          1
14     2 B      B          1
15     2 B      C          0
16     2 C      A          1
17     2 C      B          1
18     2 C      C          1

Answer 2

這可能比table快一點：

library(data.table)

df <- data.table(group = c(rep(1, 6), rep(2, 6)),
                 class1 = c("A", "A", "B", "B", "B", "C", "B", "B", "B", "C", "C", "C"),
                 class2 = c("A", "B", "B", "B", "C", "B", "B", "B", "A", "C", "A", "B"))

u <- lapply(df, function(x) sort(unique(x)))
m <- rev(cumprod(c(1, rev(lengths(u)))))
do.call(CJ, u)[
  , N := tabulate(rowSums(mapply(function(i) (match(df[[i]], u[[i]]) - 1)*m[i + 1], 1:ncol(df))) + 1, m[1])
][]
#>     group class1 class2 N
#>  1:     1      A      A 1
#>  2:     1      A      B 1
#>  3:     1      A      C 0
#>  4:     1      B      A 0
#>  5:     1      B      B 2
#>  6:     1      B      C 1
#>  7:     1      C      A 0
#>  8:     1      C      B 1
#>  9:     1      C      C 0
#> 10:     2      A      A 0
#> 11:     2      A      B 0
#> 12:     2      A      C 0
#> 13:     2      B      A 1
#> 14:     2      B      B 2
#> 15:     2      B      C 0
#> 16:     2      C      A 1
#> 17:     2      C      B 1
#> 18:     2      C      C 1

為更大的數據集計時：

library(stringi)

df <- data.table(
  group = sample(20, 2e7, TRUE),
  class1 = stri_rand_strings(2e7, 2, "[A-Za-z]"),
  class2 = stri_rand_strings(2e7, 2, "[A-Za-z]")
)

system.time({
  u <- lapply(df, function(x) sort(unique(x)))
  m <- rev(cumprod(c(1, rev(lengths(u)))))
  output <- do.call(CJ, u)[
    , N := tabulate(rowSums(mapply(function(i) (match(df[[i]], u[[i]]) - 1)*m[i + 1], 1:ncol(df))) + 1, m[1])
  ]
})
#>    user  system elapsed 
#>    3.98    0.68    4.41

與table相比：

system.time({output <- setorder(as.data.table(table(df)))})
#>    user  system elapsed 
#>   28.40    3.64   13.77

即使有 20M 行， table也在幾秒鍾內完成。 我的猜測是 OP 經歷的 > 30 分鍾時間是由於group 、 class1和class2的大量組合。

Answer 3

使用data.table ：

setDT(df)[CJ(group=unique(group),class1=unique(class1),class2=unique(class2))
          ,.(group,x.group,class1,class2),on=.(group,class1,class2)][
          ,.(N=sum(!is.na(x.group))),by=.(group,class1,class2)]

    group class1 class2     N
    <num> <char> <char> <int>
 1:     1      A      A     1
 2:     1      A      B     1
 3:     1      A      C     0
 4:     1      B      A     0
 5:     1      B      B     2
 6:     1      B      C     1
 7:     1      C      A     0
 8:     1      C      B     1
 9:     1      C      C     0
10:     2      A      A     0
11:     2      A      B     0
12:     2      A      C     0
13:     2      B      A     1
14:     2      B      B     2
15:     2      B      C     0
16:     2      C      A     1
17:     2      C      B     1
18:     2      C      C     1

但是，這比您的初始解決方案慢得多：

microbenchmark::microbenchmark(table = {df %>% table() %>% as.data.table()},
                               data.table = setDT(df)[CJ(group=unique(group),class1=unique(class1),class2=unique(class2)),.(group,x.group,class1,class2),on=.(group,class1,class2)][
                                     ,.(N=sum(!is.na(x.group))),by=.(group,class1,class2)] )

Unit: microseconds
       expr      min        lq     mean    median       uq       max neval
      table  546.501  615.9015  737.100  697.6505  775.152  1619.901   100
 data.table 4242.001 4495.0010 5038.249 4766.6005 5192.601 14618.100   100