Styjun

I'm not fluent in R data.table and any help will be greatly appreciated to resolve the following problem !
I have big data.table(~1000000 rows) with columns of numeric values and i want to output a same dimension data.table with the sorted indexes position of each row values.

a short example:

-Input:

dt = data.frame(ack = 1:7)

dt$A1 = c( 1, 6, 9, 10, 3, 5, NA)
dt$A2 = c( 25, 12, 30, 10, 50, 1, 30)
dt$A3 = c( 100, 63, 91, 110, 1, 4, 10)
dt$A4 = c( 51, 65, 2, 1, 0, 200, 1)

first row: 1 (1) <= 25 (2) <= 51 (3) <= 100 (4),
row sorted indexes position for (1, 25, 100, 51) are (1, 2, 4, 3) and output should be:

dt$PosA1 = c(1, ...
dt$PosA2 = c(2, ...
dt$PosA3 = c(4, ...
dt$PosA4 = c(3, ...

3rd row : 2 (1) <= 9 (2) <= 30 (3) <= 91 (4) , must output:

dt$PosA1 = c( 1,1,2,...)
dt$PosA2 = c( 2,2,3,...)
dt$PosA3 = c( 4,3,4,...)
dt$PosA4 = c( 3,4,1,...)

Output is a same dimension of input data.table filled with values of sorted indexes by rows .

dt$PosA1 = c( 1, 1, 2, 2, 3, 1, NA)
dt$PosA2 = c( 2, 2, 3, 3, 4, 2, 3)
dt$PosA3 = c( 4, 3, 4, 4, 2, 2, 2)
dt$PosA4 = c( 3, 4, 1, 1, 1, 4, 1)

I think about perhaps something like this?

library(data.table)
setDT(dt)

# pseudocode
dt[, PosA1 := rowPosition(.SD, 1, na.rm=T),
 PosA2 := rowPosition(.SD, 2, na.rm=T),
 PosA3 := rowPosition(.SD, 3, na.rm=T),
 PosA4 := rowPosition(.SD, 4, na.rm=T),
 .SDcols=c(A1, A2, A3, A4)]

I'm not sure of syntax and i miss a rowPosition Function. does any function exist to do that ? (i named it rowPosition here)

A little help would be great to code an efficient one , or another approach to solve the problem!

regards.

Since you are looking for speed, you might want to consider using Rcpp. A Rcpp rank that takes care of NA and ties can be found in nrussell's adapted version of René Richter's code.

nr <- 811e3
nc <- 16
DT <- as.data.table(matrix(sample(c(1:200, NA), nr*nc, replace=TRUE), nrow=nr))[, 
 ack := .I]

#assuming that you have saved nrussell code in avg_rank.cpp
library(Rcpp)
system.time(sourceCpp("rcpp/avg_rank.cpp"))
# user system elapsed 
# 0.00 0.13 6.21 

nruss_rcpp <- function() 
 DT[, as.list(avg_rank(unlist(.SD))), by=ack]


data.table.frank <- function() 
 melt(DT, id="ack")[, f := frank(value, na.last="keep", ties.method="dense"), by=ack][, 
 dcast(.SD, ack ~ variable, value.var="f")]



library(microbenchmark)
microbenchmark(nruss_rcpp(), data.table.frank(), times=3L)

timings:

Unit: seconds
 expr min lq mean median uq max neval cld
 nruss_rcpp() 10.33032 10.33251 10.3697 10.3347 10.38939 10.44408 3 a 
 data.table.frank() 610.44869 612.82685 613.9362 615.2050 615.68001 616.15501 3 b

edit: addressing comments

1) set column names for rank columns using updating by reference

DT[, (paste0("Rank", 1L:nc)) := as.list(avg_rank(unlist(.SD))), by=ack]

2) keeping NAs as it is

option A) change to NA in R after getting output from avg_rank:

for (j in 1:nc) 
 DT[is.na(get(paste0("V", j))), (paste0("Rank", j)) := NA_real_]

option B) amend the avg_rank code in Rcpp as follows:

Rcpp::NumericVector avg_rank(Rcpp::NumericVector x)

 R_xlen_t sz = x.size();
 Rcpp::IntegerVector w = Rcpp::seq(0, sz - 1);
 std::sort(w.begin(), w.end(), Comparator(x));

 Rcpp::NumericVector r = Rcpp::no_init_vector(sz);
 for (R_xlen_t n, i = 0; i < sz; i += n) 
 n = 1;
 while (i + n < sz && x[w[i]] == x[w[i + n]]) ++n;
 for (R_xlen_t k = 0; k < n; k++) 
 if (Rcpp::traits::is_na<REALSXP>(x[w[i + k]])) #additional code
 r[w[i + k]] = NA_REAL; #additional code
 else 
 r[w[i + k]] = i + (n + 1) / 2.;
 
 
 

 return r;

You can convert to long form and use rank. Or, since you're using data.table, frank:

library(data.table)
setDT(dt)
melt(dt, id="ack")[, f := frank(value, na.last="keep", ties.method="dense"), by=ack][, 
 dcast(.SD, ack ~ variable, value.var="f")]

 ack A1 A2 A3 A4
1: 1 1 2 4 3
2: 2 1 2 3 4
3: 3 2 3 4 1
4: 4 2 2 3 1
5: 5 3 4 2 1
6: 6 3 1 2 4
7: 7 NA 3 2 1

melt switches to long form; while dcast converts back to wide form.