I have been using a small tab
function for some time, which shows the frequency, percent, and cumulative percent for a vector. The output looks like this
Freq Percent cum
ARSON 462 0.01988893 0.01988893
BURGLARY 22767 0.98011107 1.00000000
23229 1.00000000 NA
The excellent dplyr
package motivated me to update the function. Now I am wondering how I can make the updated version even faster. Here is the old function
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
}
and the new based on 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
}
Finally, some performance benchmarks:
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
is faster except for the very short vector. The performance gain becomes evident in the larger vector (see x4
with 51002 obs). It's also faster than table
even thought the function is doing much more.
Now to my question: How can I further improve performance? Creating tables with frequencies and percent is a pretty standard application and a fast implementation is very nice when you work with large datasets.
EDIT: Here is an additional test case with a 2e6 vector (including the data.table
solution proposed below)
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