r - zastosować funkcję do każdego wiersza z data.table

Question

szukam korzystać data.table celu zwiększenia szybkości dla danej funkcji, ale nie jestem pewien, że jestem jej wdrażania prawidłowy sposób:

dane

podawana dwa data.table s (dt i 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) 

mam funkcji znajdująca lkpId zawierający zarówno thisLocation i finalLocation i ma "najbliższy" lkpTime (tj. minimalna nieujemną wartość thisTime - lkpTime)

Funkcja

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

Próby rozwiązania

trzeba uzyskać lkpId dla każdego rzędu dt. Dlatego moim początkowym instynktem było użycie funkcji *apply, ale trwało to zbyt długo (dla mnie), gdy n/nrow > 1,000,000. Więc starałem się wdrożyć rozwiązanie data.table, aby zobaczyć, czy to szybciej:

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

Jednak jestem dość nowy data.table, a metoda ta wydaje się nie dawać żadnych wzrost wydajności ponad roztworze *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) 
}) 

oba trwają ~ 30 sekund dla n = 10 000.

Pytanie

Czy istnieje lepszy sposób korzystania data.table zastosować funkcję getId nad każdym rzędzie dt?

Aktualizuj 12/08/2015

Dzięki wskaźnik z @eddi Mam przebudowany całe algorytm i robię zastosowanie skręcania przyłącza (a good introduction), a tym samym właściwego stosowania data.table. Napiszę później odpowiedź.

Answer 1

Spędzając czas z tym pytaniem, ponieważ patrząc na what data.table has to offer, badania data.table dołącza dzięki wskaźnik @ Eddi (na przykład Rolling join on data.table i inner join with inequality), mam wymyślić rozwiązanie.

Jedną z trudnych części było odejście od myśli "Zastosuj funkcję do każdego rzędu" i przeprojektowanie rozwiązania w celu użycia sprzężeń.

I bez wątpienia będą lepsze sposoby programowania tego, ale oto moja próba.

## 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's 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