Row Wise Mode в data.table R - PullRequest
Новая
       12

Row Wise Mode в data.table R

0 голосов
/ 17 мая 2018

Я пытаюсь найти эффективный способ получения строчных режимов для подмножества столбцов в 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)

Я знаю из: Чтобы найти "строчный" режим"из данных в R , что я могу сделать это: 

Mode <- function(x) {
     ux <- unique(x)
          ux[which.max(tabulate(match(x, ux)))]
    }   

apply(a[ ,paste0("dattyp",1:6)], 1, Mode)

Но это действительно медленно (по моим миллионам записей).Я думаю, что должен быть способ сделать это с .SDcols - но это делает режимы столбцов, а не строки. 

a<- data.table( a )
    a[ , lapply(.SD , mfv ), .SDcols=c(paste0("dattyp",1:6) ) ]

Ответы [ 2 ]

0 голосов
/ 17 мая 2018

Я думаю, что самый быстрый способ через по-прежнему заключается в преобразовании в реляционный (т. Е. Длинный) формат и агрегировании, а затем нахождении max в функции reldtMtd следующим образом.Интересно, будет ли использование Rcpp быстрее?

данные: 

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)

методы: 

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)

время: 

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
0 голосов
/ 17 мая 2018

Вы можете попробовать это, хотя я не уверен, насколько быстрее это будет. Обратите внимание, я беру первое число, возвращаемое 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 ]

дата может быть быстрее. Применение: 

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

датируется: 

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
...