применить rank () для подмножества data.table и всей таблицы - PullRequest
Новая
       3

применить rank () для подмножества data.table и всей таблицы

1 голос
/ 03 марта 2020

У меня есть таблица данных с цифрами c Значения X и Y. Мне нужно пометить записи значениями Y из top-5 и bottom-5 из 3 групп: 1) все записи, 2) записи с X = 0, 3) записи с X = 0.5. Мое текущее решение вычисляет rank() отдельно, добавляя соответствующие столбцы в таблицу: 

set.seed(1)
dt1 <- data.table(valueX=round(rnorm(1e6),2),
                  valueY=round(rnorm(1e6),2)) # I also have many other columns that I'll want to keep

dt1[,          all.top:=rank( valueY)]
dt1[,          all.btm:=rank(-valueY)]
dt1[valueX==0,  X0.top:=rank( valueY)]
dt1[valueX==0,  X0.btm:=rank(-valueY)]
dt1[valueX==.5, X5.top:=rank( valueY)]
dt1[valueX==.5, X5.btm:=rank(-valueY)]

dt1[, selected:=(all.top<6 | all.btm<6 | 
                 X0.top <6 | X0.btm <6 | 
                 X5.top <6 | X5.btm <6 )]

Есть ли какой-нибудь однострочник, который пропустил бы создание промежуточных столбцов?

UPD. Добавление некоторого теста производительности: решение с head() / tail(), предложенное @ chinsoon12, намного быстрее, чем использование rank(): 

solution_ranks <- function(inpDT){
  inpDT[,          all.top:=rank( valueY)]
  inpDT[,          all.btm:=rank(-valueY)]
  inpDT[valueX==0,  X0.top:=rank( valueY)]
  inpDT[valueX==0,  X0.btm:=rank(-valueY)]
  inpDT[valueX==.5, X5.top:=rank( valueY)]
  inpDT[valueX==.5, X5.btm:=rank(-valueY)]

  inpDT[, selected:=(all.top<6 | all.btm<6 | 
                       X0.top <6 | X0.btm <6 | 
                       X5.top <6 | X5.btm <6 )]

  inpDT[,c('all.top','all.btm','X0.top','X0.btm','X5.top','X5.btm'):=NULL]

  return(inpDT)
}

solution_ht <- function(inpDT){
  ht <- function(x, n=5L) unique(c(head(x, n), tail(x, n)))
  inpDT[, rn := .I]
  inpDT[rn %in% inpDT[order(valueY),c(ht(rn),ht(rn[valueX==0]),ht(rn[valueX==0.5]))],
        selected:=TRUE]
  return(inpDT)
}

require(microbenchmark)
print(microbenchmark(
  solution_ranks(dt1), 
  solution_ht(dt1), 
  times=3L 
), signif=3)
# 
# Unit: milliseconds
#                expr  min   lq mean median   uq  max neval
# solution_ranks(dt1) 1050 1070 1080   1080 1090 1090     3
# solution_ht(dt1)     113  114  143    116  159  202     3

1 Ответ

0 голосов
/ 03 марта 2020

Вот предложение: 

ht.avg <- function(DT, n=6L) {
    DT[, {
        rnk <- frank(Y)
        rn[rnk < n | (.N + 1L - rnk) < n]
    }]
}

DT[, rn := .I]
setorder(DT, Y)

cols <- c("rn", "X", "Y")
ans <- DT[rn %in% DT[, sort(unique(c(
        ht.avg(.SD), ht.avg(.SD[X==1L]), ht.avg(.SD[X==2L])
    ))), .SDcols=cols]]
setorder(ans, rn)[]

вывод: 

    X   Y  rn
 1: 0   1   1
 2: 0   2   2
 3: 0   3   3
 4: 0   4   4
 5: 0   5   5
 6: 1  26  26
 7: 1  27  27
 8: 1  28  28
 9: 1  29  29
10: 1  30  30
11: 1  46  46
12: 1  47  47
13: 1  48  48
14: 1  49  49
15: 1  50  50
16: 2  51  51
17: 2  52  52
18: 2  53  53
19: 2  54  54
20: 2  55  55
21: 2  71  71
22: 2  72  72
23: 2  73  73
24: 2  74  74
25: 2  75  75
26: 3  96  96
27: 3  97  97
28: 3  98  98
29: 3  99  99
30: 3 100 100
    X   Y  rn

данные: 

nr <- 100L
DT <- data.table(X=rep(0L:3L, each=nr/4L), Y=1L:nr)
...