R: использование data.table: = операции для вычисления новых столбцов

Возьмем следующие данные:

dt <- data.table(TICKER=c(rep("ABC",10),"DEF"),
        PERIOD=c(rep(as.Date("2010-12-31"),10),as.Date("2011-12-31")),
        DATE=as.Date(c("2010-01-05","2010-01-07","2010-01-08","2010-01-09","2010-01-10","2010-01-11","2010-01-13","2010-04-01","2010-04-02","2010-08-03","2011-02-05")),
        ID=c(1,2,1,3,1,2,1,1,2,2,1),VALUE=c(1.5,1.3,1.4,1.6,1.4,1.2,1.5,1.7,1.8,1.7,2.3))
setkey(dt,TICKER,PERIOD,ID,DATE)

Теперь для каждой комбинации тикер/период мне нужно следующее в новом столбце:

  • PRIORAVG: среднее значение последнего значения VALUE каждого идентификатора, за исключением текущего идентификатора, при условии, что оно не превышает 180 дней.
  • PREV: предыдущее значение из того же идентификатора.

Результат должен выглядеть так:

      TICKER     PERIOD       DATE ID VALUE PRIORAVG PREV
 [1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA   NA
 [2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30  1.5
 [3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45  1.4
 [4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40  1.4
 [5,]    ABC 2010-12-31 2010-04-01  1   1.7     1.40  1.5
 [6,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50   NA
 [7,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50  1.3
 [8,]    ABC 2010-12-31 2010-04-02  2   1.8     1.65  1.2
 [9,]    ABC 2010-12-31 2010-08-03  2   1.7     1.70  1.8
[10,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35   NA
[11,]    DEF 2011-12-31 2011-02-05  1   2.3       NA   NA

Обратите внимание, что PRIORAVG в строке 9 равно 1.7 (что равно VALUE в строке 5, что является единственным предыдущим наблюдением за последние 180 дней другим ID)

Я обнаружил пакет data.table, но я не могу полностью понять функцию :=. Когда я держу это просто, это работает. Чтобы получить предыдущее значение для каждого ID (я основывал это на решении на этом вопросе):

dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),roll=TRUE,mult="last"][,VALUE]]

Это отлично работает, и для выполнения этой операции по моему набору данных требуется ~ 0,13 секунды с ~ 250 тыс. строк; моя функция векторного сканирования получает одинаковые результаты, но примерно в 30 000 раз медленнее.

Хорошо, поэтому у меня есть мое первое требование. Давайте перейдем ко второму, более сложному требованию. Прямо сейчас для меня метод fasted использует пару векторных сканов и бросает функцию через функцию plyr adply, чтобы получить результат для каждой строки.

calc <- function(df,ticker,period,id,date) {
  df <- df[df$TICKER == ticker & df$PERIOD == period 
        & df$ID != id & df$DATE < date & df$DATE > date-180, ]
  df <- df[order(df$DATE),]
  mean(df[!duplicated(df$ID, fromLast = TRUE),"VALUE"])
}

df <- data.frame(dt)
adply(df,1,function(x) calc(df,x$TICKER,x$PERIOD,x$ID,x$DATE))

Я написал функцию для data.frame и, похоже, не работает с data.table. Для подмножества 5000 строк это занимает около 44 секунд, но мои данные состоят из > 1 миллиона строк. Интересно, можно ли сделать это более эффективным с помощью :=.

dt[J("ABC"),last(VALUE),by=ID][,mean(V1)]

Это работает, чтобы выбрать среднее значение последних значений VALUE для каждого идентификатора для ABC.

dt[,PRIORAVG:=dt[J(TICKER,PERIOD),last(VALUE),by=ID][,mean(V1)]]

Это, однако, не работает должным образом, так как оно принимает среднее значение для всех последних значений VALUE для всех тикеров/периодов, а не только для текущего тикера/периода. Таким образом, он заканчивается тем, что все строки получают одинаковое среднее значение. Я делаю что-то неправильно или это ограничение :=?

Ответы

Ответ 1

Отличный вопрос. Попробуйте следующее:

dt
     TICKER     PERIOD       DATE ID VALUE
[1,]    ABC 2010-12-31 2010-01-05  1   1.5
[2,]    ABC 2010-12-31 2010-01-08  1   1.4
[3,]    ABC 2010-12-31 2010-01-10  1   1.4
[4,]    ABC 2010-12-31 2010-01-13  1   1.5
[5,]    ABC 2010-12-31 2010-01-07  2   1.3
[6,]    ABC 2010-12-31 2010-01-11  2   1.2
[7,]    ABC 2010-12-31 2010-01-09  3   1.6
[8,]    DEF 2011-12-31 2011-02-05  1   2.3

ids = unique(dt$ID)
dt[,PRIORAVG:=NA_real_]
for (i in 1:nrow(dt))
    dt[i,PRIORAVG:=dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]),
                      mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"]]
dt
     TICKER     PERIOD       DATE ID VALUE PRIORAVG
[1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA
[2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30
[3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45
[4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40
[5,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50
[6,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50
[7,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35
[8,]    DEF 2011-12-31 2011-02-05  1   2.3       NA

Тогда то, что у вас уже было с небольшим упрощением...

dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),VALUE,roll=TRUE,mult="last"]]

     TICKER     PERIOD       DATE ID VALUE PRIORAVG PREV
[1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA   NA
[2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30  1.5
[3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45  1.4
[4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40  1.4
[5,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50   NA
[6,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50  1.3
[7,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35   NA
[8,]    DEF 2011-12-31 2011-02-05  1   2.3       NA   NA

Если это будет хорошо, как прототип, то улучшение скорости будет состоять в том, чтобы сохранить цикл, но вместо := использовать set(), чтобы уменьшить накладные расходы:

for (i in 1:nrow(dt))
    set(dt,i,6L,dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]),
                   mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"])
dt
     TICKER     PERIOD       DATE ID VALUE PRIORAVG PREV
[1,]    ABC 2010-12-31 2010-01-05  1   1.5       NA   NA
[2,]    ABC 2010-12-31 2010-01-08  1   1.4     1.30  1.5
[3,]    ABC 2010-12-31 2010-01-10  1   1.4     1.45  1.4
[4,]    ABC 2010-12-31 2010-01-13  1   1.5     1.40  1.4
[5,]    ABC 2010-12-31 2010-01-07  2   1.3     1.50   NA
[6,]    ABC 2010-12-31 2010-01-11  2   1.2     1.50  1.3
[7,]    ABC 2010-12-31 2010-01-09  3   1.6     1.35   NA
[8,]    DEF 2011-12-31 2011-02-05  1   2.3       NA   NA

Это должно быть намного быстрее, чем повторные векторные проверки, показанные в вопросе.

Или операция может быть векторизованной. Но это было бы легче написать и прочитать из-за особенностей этой задачи.

Btw, нет никаких данных в вопросе, которые будут проверять требование 180 дней. Если вы добавите некоторые из них и покажете ожидаемый результат, я добавлю счет возраста, используя присоединенную наследованную область, о которой я упоминал в комментариях.