Row Wise Mode in data.table R - r

Question

I am trying to find an efficient way to get a row wise modes on a subset of columns in data.table
#Sample data
a <- data.frame(
id=letters[],
dattyp1 = sample( 1:2, 26, replace=T) ,
dattyp2 = sample( 1:2, 26, replace=T) ,
dattyp3 = sample( 1:2, 26, replace=T) ,
dattyp4 = sample( 1:2, 26, replace=T) ,
dattyp5 = sample( 1:2, 26, replace=T) ,
dattyp6 = sample( 1:2, 26, replace=T)
)
library(modeest)
library(data.table)
I know from: To find "row wise" "Mode" of a given data in R that I can do this:
Mode <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
apply(a[ ,paste0("dattyp",1:6)], 1, Mode)
But this is really slow (over my millions of records). I am thinking there must be a way to do it with .SDcols - but this does column wise modes not row wise.
a<- data.table( a )
a[ , lapply(.SD , mfv ), .SDcols=c(paste0("dattyp",1:6) ) ]

Answer 1

I think the fastest way via data.table is still to convert into a relational (i.e. long) format and aggregate and then find max in reldtMtd function as follows. I wonder if using Rcpp will be faster.
data:
library(data.table)
M <- 1e6
popn <- 2
set.seed(0L)
a <- data.frame(
id=1:M,
dattyp1 = sample(popn, M, replace=TRUE),
dattyp2 = sample(popn, M, replace=TRUE),
dattyp3 = sample(popn, M, replace=TRUE),
dattyp4 = sample(popn, M, replace=TRUE),
dattyp5 = sample(popn, M, replace=TRUE),
dattyp6 = sample(popn, M, replace=TRUE)
)
setDT(a)
methods:
reldtMtd <- function() {
melt(a, id.vars="id")[,
.N, by=.(id, value)][,
value[which.max(N)], by=.(id)]
}
#from https://stackoverflow.com/a/8189441/1989480
Mode <- compiler::cmpfun(function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
})
Mode2 <- compiler::cmpfun(function(x) names(which.max(table(x))))
matA <- as.matrix(a[, -1L])
baseMtd1 <- function() apply(matA, 1, Mode)
baseMtd2 <- function() apply(matA, 1, Mode2)
library(microbenchmark)
microbenchmark(reldtMtd(), baseMtd1(), baseMtd2(), times=3L)
timings:
Unit: seconds
expr min lq mean median uq max neval
reldtMtd() 1.882783 1.947515 2.031767 2.012248 2.106259 2.20027 3
baseMtd1() 15.618716 15.675314 15.809277 15.731913 15.904557 16.07720 3
baseMtd2() 160.837513 161.692634 162.455048 162.547755 163.263816 163.97988 3

Answer 2

You can try this -though I am not sure how much faster it will be. Note, I am grabbing the first number returned by mfv.
library(modeest)
library(data.table)
a <- data.frame(
id=letters[],
dattyp1 = sample( 1:2, 26, replace=T) ,
dattyp2 = sample( 1:2, 26, replace=T) ,
dattyp3 = sample( 1:2, 26, replace=T) ,
dattyp4 = sample( 1:2, 26, replace=T) ,
dattyp5 = sample( 1:2, 26, replace=T) ,
dattyp6 = sample( 1:2, 26, replace=T)
)
a<- data.table( a )
a[ , Mode:=mfv(c(dattyp1,dattyp2,dattyp3,dattyp4,dattyp5,dattyp6))[1],by=id ]
datatable could be faster.
Apply:
microbenchmark(apply={
+ apply(a[ ,paste0("dattyp",1:6)], 1, Mode)
+ })
Unit: microseconds
expr min lq mean median uq max neval
apply 574.025 591.803 1056.807 624.988 704.396 39236.79 100
datatable by:
microbenchmark({
+ a[ , Mode:=mfv(c(dattyp1,dattyp2,dattyp3,dattyp4,dattyp5,dattyp6))[1],by=id ]
+ })
Unit: milliseconds
expr min lq
{ a[, `:=`(Mode, mfv(c(dattyp1, dattyp2, dattyp3, dattyp4, dattyp5, dattyp6))[1]), by = id] } 2.44109 2.748053
mean median uq max neval
3.049809 2.898769 3.139559 6.398032 100