Data.table：如何获取它所承诺的极快的子集并将其应用于第二个 data.table

我试图根据另一个数据集（lsr）的子集来丰富一个数据集（依从性）。对于依从性中的每一行，我想计算（作为第三列）可用于实施规定方案的药物。我有一个返回相关结果的函数，但它仅在我必须运行它的总数据的一个子集上运行数天。

数据集是：

 library(dplyr)
library(tidyr)
library(lubridate)
library(data.table)

adherence <- cbind.data.frame(c("1", "2", "3", "1", "2", "3"), c("2013-01-01", "2013-01-01", "2013-01-01", "2013-02-01", "2013-02-01", "2013-02-01"))
names(adherence)[1] <- "ID" 
names(adherence)[2] <- "year"
adherence$year <- ymd(adherence$year)

lsr <- cbind.data.frame(
  c("1", "1", "1", "2", "2", "2", "3", "3"), #ID
  c("2012-03-01", "2012-08-02", "2013-01-06","2012-08-25", "2013-03-22", "2013-09-15", "2011-01-01", "2013-01-05"), #eksd
  c("60", "90", "90", "60", "120", "60", "30", "90") # DDD
)
names(lsr)[1] <- "ID"
names(lsr)[2] <- "eksd"
names(lsr)[3] <- "DDD"

lsr$eksd <- as.Date((lsr$eksd))
lsr$DDD <- as.numeric(as.character(lsr$DDD))
lsr$ENDDATE <- lsr$eksd + lsr$DDD
lsr <- as.data.table(lsr)

adherence <- as.data.table(adherence)

我习惯使用 dplyr，但它慢得多，我重写了 data.table 的内容来尝试一下。令我抓狂的是，我与 SAS 合作的同事声称这对他们来说不会花费很长时间，而我只是将数据本身加载到 RAM 中就需要几个小时。 （fread 在我的几个数据集上导致 R 崩溃）。 依从性为 1.5 mio 行，LSR 为几百 mio。行。

我的工作功能是

function.AH <- function(x) {
  lsr[ID == x[1] & eksd <= x[2] & ENDDATE > x[2], ifelse(.N == 0, 0, sum(as.numeric(ENDDATE - as.Date(x[2]))))]
}
setkey(lsr, ID, eksd, ENDDATE)
adherence$AH <-apply (adherence, 1,  FUN = function.AH) #DESIRED OUTPUT

我不知道最好的方法：我已经研究过使用 SQL 数据库，但据我了解，当我的数据适合 RAM（我有 256GB）时，这不应该更快。由于依从性 data.table 实际上是重复 500 个时间段的每个单独 ID（即 ID 1：在时间 1、时间 2、时间 3...时间 500，ID 2：在时间 1、时间 2...等）我还考虑过在 lsr 上的 ID 上使用 by 函数，以及如何将此时间间隔 (1:500) 嵌入到 j 中的函数中。

我希望有人能够指出我如何低效地使用 apply 函数，而不是以某种方式将其应用到 data.table-framework 中，从而失去了构建效率。但由于我将处理这些数据和类似大小的数据，因此我很感激任何用于更快解决此问题的具体建议或使用其他方法获得更快运行时间的一般建议。

这可以通过以下方式解决在非等值连接中更新.

这避免了由笛卡尔连接或调用引起的内存问题apply()它将 data.frame 或 data.table 强制转换为涉及复制数据的矩阵。

此外，OP 还提到lsr has a 几百米奥。行 and adherence有 1.5 mio 行（500 个时间段乘以 3000ID的）。因此，数据项的有效存储不仅会减少内存占用，而且还可以减少加载数据所需的处理时间份额。

library(data.table)
# coerce to data.table by reference, i.e., without copying
setDT(adherence)
setDT(lsr)
# coerce to IDate to save memory
adherence[, year := as.IDate(year)]
cols <- c("eksd", "ENDDATE")
lsr[, (cols) := lapply(.SD, as.IDate), .SDcols = cols]
# update in a non-equi join
adherence[lsr, on = .(ID, year >= eksd, year < ENDDATE), 
                      AH := as.integer(ENDDATE - x.year)][]

   ID       year AH
1:  1 2013-01-01 NA
2:  2 2013-01-01 NA
3:  3 2013-01-01 NA
4:  1 2013-02-01 64
5:  2 2013-02-01 NA
6:  3 2013-02-01 63

注意NA表明没有找到匹配项。如果需要的话，AH列可以在非等值连接之前初始化adherence[, AH := 0L].

Data

可以简化创建示例数据集的代码：

adherence <- data.frame(
  ID = c("1", "2", "3", "1", "2", "3"), 
  year = as.Date(c("2013-01-01", "2013-01-01", "2013-01-01", "2013-02-01", "2013-02-01", "2013-02-01")),
  stringsAsFactors = FALSE)

lsr <- data.frame(
  ID = c("1", "1", "1", "2", "2", "2", "3", "3"),
  eksd = as.Date(c("2012-03-01", "2012-08-02", "2013-01-06","2012-08-25", "2013-03-22", "2013-09-15", "2011-01-01", "2013-01-05")),
  DDD = as.integer(c("60", "90", "90", "60", "120", "60", "30", "90")),
  stringsAsFactors = FALSE)
lsr$ENDDATE <- lsr$eksd + lsr$DDD

注意DDD是整数类型，通常需要 4 个字节，而不是 numeric/double 类型的 8 个字节。

另请注意最后一条语句may导致整个数据对象lsr被复制。可以通过使用通过引用更新的 data.table 语法来避免这种情况。

library(data.table)
setDT(lsr)[, ENDDATE := eksd + DDD][]