r - áp dụng chức năng cho mỗi hàng của một data.table

Question

tôi đang tìm cách để sử dụng data.table để cải thiện tốc độ cho một chức năng nhất định, nhưng tôi không chắc là tôi đang thực hiện điều đó một cách chính xác:

dữ liệu

cho hai data.table s (dt và 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) 

tôi có một chức năng tìm lkpId có chứa cả thisLocation và finalLocation và có 'gần nhất' lkpTime (tức là giá trị không âm tối thiểu thisTime - lkpTime)

Chức năng

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

Nỗ lực tại một giải pháp

tôi cần phải nhận được lkpId cho mỗi hàng của dt. Do đó, bản năng ban đầu của tôi là sử dụng hàm *apply, nhưng mất quá nhiều thời gian (đối với tôi) khi n/nrow > 1,000,000. Vì vậy, tôi đã cố gắng thực hiện một giải pháp data.table để xem nếu nó là nhanh hơn:

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

Tuy nhiên, tôi khá mới để data.table, và phương pháp này không xuất hiện để đưa ra bất cứ lợi nhuận thực hiện trên một giải pháp *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) 
}) 

cả hai tham gia ~ 30 giây cho n = 10.000.

Câu hỏi

Có cách nào tốt hơn của việc sử dụng data.table để áp dụng các getId chức năng trên mỗi hàng của dt?

Cập nhật 12/08/2015

Nhờ con trỏ từ @eddi tôi đã thiết kế lại toàn bộ thuật toán của tôi và đang làm cho sử dụng cán tham gia (a good introduction), do đó làm cho sử dụng hợp lý data.table. Tôi sẽ viết một câu trả lời sau.

Answer 1

Sau khi dành thời gian kể từ khi hỏi câu hỏi này nhìn vào what data.table has to offer, nghiên cứu data.table tham gia nhờ con trỏ @ Eddi của (ví dụ Rolling join on data.table, và inner join with inequality), tôi đã tìm ra một giải pháp.

Một trong những phần phức tạp đã được di chuyển ra khỏi suy nghĩ của 'áp dụng một chức năng cho mỗi hàng', và thiết kế lại các giải pháp để sử dụng tham gia.

Và, chắc chắn sẽ có cách tốt hơn để lập trình này, nhưng đây là nỗ lực của tôi.

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