Существует ли функция R для возврата отсортированных индексов любых значений вектора?

Question

Я не владею R data.table, и любая помощь будет принята с благодарностью для решения следующей проблемы! У меня есть большой data.table (~ 1000000 строк) со столбцами числовых значений, и я хочу вывести один и тот же размерный data.table с отсортированной позицией индексов значений каждой строки.

краткий пример:

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

первый ряд: 1 ( 1 ) <= 25 (<B> 2 ) <= 51 (<B> 3 ) <= 100 (<B> 4 * 1015) *), Позиции отсортированных по строкам индексов для (1, 25, 100, 51) равны (1, 2, 4, 3) и вывод должен быть:

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

3-й ряд: 2 ( 1 ) <= 9 (<B> 2 ) <= 30 (<B> 3 ) <= 91 (<B> 4 ), должен вывести:

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

Выходные данные - это то же измерение входной таблицы данных, заполненной значениями отсортированных индексов по строкам.

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)

Я думаю о чем-то вроде этого?

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)]

Я не уверен в синтаксисе, и мне не хватает функции rowPosition. существует ли какая-либо функция для этого? (я назвал это rowPosition здесь)

Небольшая помощь будет полезна для написания эффективного кода или другого подхода для решения проблемы!

С уважением.

Answer 1

Вы можете преобразовать в длинную форму и использовать rank. Или, поскольку вы используете 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 переключается в длинную форму; в то время как dcast преобразует обратно в широкую форму.

Answer 2

Поскольку вы ищете скорость, вы можете рассмотреть возможность использования Rcpp. Rcpp rank, который заботится о NA и связях, можно найти в адаптированной версии nrussell кода Рене Рихтера .

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)

тайминги:

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: адресация комментариев

1) установить имена столбцов для ранговых столбцов, используя обновление по ссылке

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

2) сохранение NA как есть

вариант A) изменить на NA в R после получения результата от avg_rank:

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

вариант B) изменить код avg_rank в Rcpp следующим образом:

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;
}