使用 dplyr 的快速频率和百分比表

Posted 2023-02-16

【中文标题】使用 dplyr 的快速频率和百分比表

【英文标题】：fast frequency and percentage table with dplyr

【发布时间】：2014-02-23 23:56:25

【问题描述】：

一段时间以来，我一直在使用一个小的tab 函数，它显示了向量的频率、百分比和累积百分比。输出如下所示

          Freq    Percent        cum
ARSON      462 0.01988893 0.01988893
BURGLARY 22767 0.98011107 1.00000000
         23229 1.00000000         NA

优秀的dplyr 包激励我更新功能。现在我想知道如何使更新版本更快。这是旧功能

tab = function(x,useNA =FALSE) 
  k=length(unique(x[!is.na(x)]))+1
  if (useNA) k=k+1
  tab=array(NA,c(k,3))
  colnames(tab)=c("freq.","prob.","cum.")
  useNA=ifelse(useNA,"always","no")
  rownames(tab)=names(c(table(x,useNA=useNA),""))

  tab[-nrow(tab),1]=table(x,useNA=useNA)
  tab[-nrow(tab),2]=prop.table(table(x,useNA=useNA))
  tab[,3] = cumsum(tab[,2])
  if(k>2)  tab[nrow(tab),-3]=colSums(tab[-nrow(tab),-3])
  if(k==2) tab[nrow(tab),-3]=tab[-nrow(tab),-3]

  tab

以及基于dplyr的新版本

tab2 = function(x, useNA =FALSE) 
    if(!useNA) if(any(is.na(x))) x = na.omit(x)
    n = length(x)
    out = data.frame(x,1) %.%
        group_by(x) %.%
        dplyr::summarise(
            Freq    = length(X1),
            Percent = Freq/n
        ) %.%
        dplyr::arrange(x)
    ids = as.character(out$x)
    ids[is.na(ids)] = '<NA>'
    out = select(out, Freq, Percent)
    out$cum = cumsum(out$Percent)
    class(out)="data.frame"
    out = rbind(out,c(n,1,NA))
    rownames(out) = c(ids,'')
    out

最后，一些性能基准：

x1 = c(rep('ARSON',462),rep('BURGLARY',22767))
x2 = c(rep('ARSON',462),rep('BURGLARY',22767),rep(NA,100))
x3 = c(c(1:10),c(1:10),1,4)
x4 = c(rep(c(1:100),500),rep(c(1:50),20),1,4)

library('rbenchmark')

benchmark(tab(x1), tab2(x1), replications=100)[,c('test','elapsed','relative')]
#       test elapsed relative
# 1  tab(x1)   1.412    2.307
# 2 tab2(x1)   0.612    1.000

benchmark(tab(x2),tab2(x2), replications=100)[,c('test','elapsed','relative')]
#       test elapsed relative
# 1  tab(x2)   1.351    1.475
# 2 tab2(x2)   0.916    1.000

benchmark(tab(x2,useNA=TRUE), tab2(x2,useNA=TRUE), replications=100)[,c('test','elapsed','relative')]
#                     test elapsed relative
# 1  tab(x2, useNA = TRUE)   1.883    2.282
# 2 tab2(x2, useNA = TRUE)   0.825    1.000

benchmark(tab(x3), tab2(x3), replications=1000)[,c('test','elapsed','relative')]
#       test elapsed relative
# 1  tab(x3)   0.997    1.000
# 2 tab2(x3)   2.194    2.201

benchmark(tab(x4), tab2(x4), table(x4), replications=100)[,c('test','elapsed','relative')]
#        test elapsed relative
# 1   tab(x4)  19.481   18.714
# 2  tab2(x4)   1.041    1.000
# 3 table(x4)   6.515    6.258

tab2 更快，除了非常短的向量。性能提升在较大的向量中变得明显（参见x4 和 51002 obs）。它也比table 更快，即使该功能做得更多。

现在我的问题是：如何进一步提高性能？创建具有频率和百分比的表是一个非常标准的应用程序，当您处理大型数据集时，快速实现非常好。

编辑：这是一个带有 2e6 向量的附加测试用例（包括下面提出的 data.table 解决方案）

x5 = sample(c(1:100),2e6, replace=TRUE)
benchmark(tab(x5), tab2(x5), table(x5), tabdt(x5), replications=100)[,c('test','elapsed','relative')]
#        test elapsed relative
# 1   tab(x5) 350.878   19.444
# 2  tab2(x5)  52.917    2.932
# 4 tabdt(x5)  18.046    1.000
# 3 table(x5)  98.429    5.454

【问题讨论】：

这些都是很小的向量，不需要花时间来运行 base - 这真的是你所说的大型数据集（或者你是在循环运行这个操作）吗？

不，我的实际数据在 1 到 5 行之间。这些只是测试用例，x4 的性能已经很明显了，它有大约 51000 obs)

好的，我建议对真实大小的数据进行基准测试，因为各种选项可以从 50k 扩展到 5M

目前正在处理中，将更新一个新案例

【参考方案1】：

因为我是library(data.table) 的忠实粉丝，所以我写了类似的函数：

tabdt <- function(x)
    n <- length(which(!is.na(x)))
    dt <- data.table(x)
    out <- dt[, list(Freq = .N, Percent = .N / n), by = x]
    out[!is.na(x), CumSum := cumsum(Percent)]
    out


> benchmark(tabdt(x1), tab2(x1), replications=1000)[,c('test','elapsed','relative')]
       test elapsed relative
2  tab2(x1)    5.60    1.879
1 tabdt(x1)    2.98    1.000
> benchmark(tabdt(x2), tab2(x2), replications=1000)[,c('test','elapsed','relative')]
       test elapsed relative
2  tab2(x2)    6.34    1.686
1 tabdt(x2)    3.76    1.000
> benchmark(tabdt(x3), tab2(x3), replications=1000)[,c('test','elapsed','relative')]
       test elapsed relative
2  tab2(x3)    1.65    1.000
1 tabdt(x3)    2.34    1.418
> benchmark(tabdt(x4), tab2(x4), replications=1000)[,c('test','elapsed','relative')]
       test elapsed relative
2  tab2(x4)   14.35    1.000
1 tabdt(x4)   22.04    1.536

所以data.table 方法对于x1 和x2 更快，而dplyr 对于x3 和x4 更快。实际上，我认为使用这些方法没有任何改进空间。

附言你会在这个问题中添加data.table 关键字吗？我相信人们会很乐意看到dplyr 与data.table 的性能比较（例如，请参阅data.table vs dplyr: can one do something well the other can't or does poorly?）。

【讨论】：

您介意使用实际基准更新您的答案吗？不幸的是，我在安装dplyr 时遇到了麻烦，所以我不能并排运行它们（并确认它们实际上产生了相同的输出）。

@BrodieG 你是什么意思，你有时间安装 dplyr。当你这样做时会发生什么install.packages("dplyr")

@RomainFrancois，出于某种原因（我可以发誓我在某个地方读到过），尽管到目前为止这只是一个 github 版本，并且遇到了建议依赖项的问题。正常安装工作正常（需要拍摄自我头部表情）。

不错！我已经添加了关键字。我认为tab2 做得更好，因为它在计数时更快（对于更长的向量）。甚至x4 也不是特别长——其他的都超级短，无论如何都会很快运行。

你的解决方案在性能方面可以稍微提升一下：tabdt2 <- function(x) NnotNA <- sum(!is.na(x)); setnames(setDT(list(x)),"x")[,list(Freq = .N, Percent = .N / NnotNA), by = x][!is.na(x), CumSum := cumsum(Percent)]