我想使用 data.table
提高给定函数的速度,但我不确定我是否以正确的方式实现它:
数据
给定两个 data.table
s( 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)
})
对于 n = 10,000,两者都需要约 30 秒。
问题
有没有更好的方法来使用
data.table
申请 getId
作用于 dt
的每一行?2015 年 8 月 12 日更新
多亏了@eddi 的指针,我重新设计了整个算法并使用了滚动连接( a good introduction ),从而正确使用了
data.table
.稍后我会写一个答案。
最佳答案
自从问这个问题以来,花了很长时间研究 what data.table
has to offer , 研究 data.table
加入感谢@eddi 的指针(例如 Rolling join on data.table 和 inner join with inequality ),我想出了一个解决方案。
棘手的部分之一是摆脱“将函数应用于每一行”的想法,并重新设计解决方案以使用连接。
而且,毫无疑问会有更好的编程方式,但这是我的尝试。
## 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
关于r - 将函数应用于 data.table 的每一行,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/31933577/