R - применить функцию к каждой строке data.table

Я хочу использовать data.table для повышения скорости для данной функции, но я не уверен, что реализую ее правильно:

Данные

Учитывая два data.table (dt и dt_lookup)

library(data.table)
set.seed(1234)
t <- seq(1,100); l <- letters; la <- letters[1:13]; lb <- letters[14:26]
n <- 10000
dt <- data.table(id=seq(1:n), 
                 thisTime=sample(t, n, replace=TRUE), 
                 thisLocation=sample(la,n,replace=TRUE),
                 finalLocation=sample(lb,n,replace=TRUE))
setkey(dt, thisLocation)

set.seed(4321)
dt_lookup <- data.table(lkpId = paste0("l-",seq(1,1000)),
                        lkpTime=sample(t, 10000, replace=TRUE),
                        lkpLocation=sample(l, 10000, replace=TRUE))
## NOTE: lkpId is purposly recycled
setkey(dt_lookup, lkpLocation)

У меня есть функция, которая находит lkpId, которая содержит как thisLocation, так и finalLocation, и имеет "ближайшее" lkpTime (т.е. минимальное неотрицательное значение thisTime - lkpTime)

Функция

## function to get the 'next' lkpId (i.e. the lkpId with both thisLocation and finalLocation,
## with the minimum non-negative time between thisTime and dt_lookup$lkpTime)
getId <- function(thisTime, thisLocation, finalLocation){

  ## filter lookup based on thisLocation and finalLocation,
  ## and only return values where the lkpId has both 'this' and 'final' locations
  tempThis <- unique(dt_lookup[lkpLocation == thisLocation,lkpId])
  tempFinal <- unique(dt_lookup[lkpLocation == finalLocation,lkpId])
  availServices <- tempThis[tempThis %in% tempFinal]

  tempThisFinal <- dt_lookup[lkpId %in% availServices & lkpLocation==thisLocation, .(lkpId, lkpTime)]

  ## calcualte time difference between 'thisTime' and 'lkpTime' (from thisLocation)
  temp2 <- thisTime - tempThisFinal$lkpTime

  ## take the lkpId with the minimum non-negative difference
  selectedId <- tempThisFinal[min(which(temp2==min(temp2[temp2>0]))),lkpId]
  selectedId
}

Попытки решения

Мне нужно получить lkpId для каждой строки dt. Поэтому мой первоначальный инстинкт заключался в использовании функции *apply, но она занимала слишком много времени (для меня), когда n/nrow > 1,000,000. Поэтому я попытался реализовать решение data.table, чтобы узнать, быстрее ли это:

selectedId <- dt[,.(lkpId = getId(thisTime, thisLocation, finalLocation)),by=id]

Однако я довольно новичок в data.table, и этот метод, похоже, не дает каких-либо выигрышей в производительности над решением *apply:

lkpIds <- apply(dt, 1, function(x){
  thisLocation <- as.character(x[["thisLocation"]])
  finalLocation <- as.character(x[["finalLocation"]])
  thisTime <- as.numeric(x[["thisTime"]])
  myId <- getId(thisTime, thisLocation, finalLocation)
})

оба принимают ~ 30 секунд для n = 10000.

Вопрос

Есть ли лучший способ использовать data.table для применения функции getId по каждой строке dt?

Обновление 12/08/2015

Благодаря указателю от @eddi я переработал весь свой алгоритм и использую скользящие соединения (хорошее введение), таким образом правильное использование data.table. Я напишу ответ позже.

Ответы

Ответ 1

Проведя время, задав этот вопрос в что data.table может предложить, исследование data.table объединяется благодаря @eddi указатель (например Rolling join на data.table и внутреннее соединение с неравенством), я пришел с помощью решения.

Одна из сложных частей отходила от мысли "применить функцию к каждой строке" и переработала решение для использования объединений.

И, несомненно, будут лучшие способы программирования этого, но здесь моя попытка.

## want to find a lkpId for each id, that has the minimum difference between 'thisTime' and 'lkpTime'
## and where the lkpId contains both 'thisLocation' and 'finalLocation'

## find all lookup id where 'thisLocation' matches 'lookupLocation'
## and where thisTime - lkpTime > 0
setkey(dt, thisLocation)
setkey(dt_lookup, lkpLocation)

dt_this <- dt[dt_lookup, {
  idx = thisTime - i.lkpTime > 0
  .(id = id[idx],
    lkpId = i.lkpId,
    thisTime = thisTime[idx],
    lkpTime = i.lkpTime)
},
by=.EACHI]

## remove NAs
dt_this <- dt_this[complete.cases(dt_this)]

## find all matching 'finalLocation' and 'lookupLocaiton'
setkey(dt, finalLocation)
## inner join (and only return the id columns)
dt_final <- dt[dt_lookup, nomatch=0, allow.cartesian=TRUE][,.(id, lkpId)]

## join dt_this to dt_final (as lkpId must have both 'thisLocation' and 'finalLocation')
setkey(dt_this, id, lkpId)
setkey(dt_final, id, lkpId)

dt_join <- dt_this[dt_final, nomatch=0]

## take the combination with the minimum difference between 'thisTime' and 'lkpTime'
dt_join[,timeDiff := thisTime - lkpTime]

dt_join <- dt_join[ dt_join[order(timeDiff), .I[1], by=id]$V1]  

## equivalent dplyr code
# library(dplyr)
# dt_this <- dt_this %>%
#   group_by(id) %>%
#   arrange(timeDiff) %>%
#   slice(1) %>%
#   ungroup