data.table by = xx 当我返回不匹配时，如何保持长度为 0 的组

Question

我正在尝试解决由于数据量大而出现的问题并且我无法找到答案。 （即Data.table: how to get the blazingly fast subsets it promises and apply to a second data.table）

这是虚拟数据。

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)

我尝试了不同的方法来实现结果：笛卡尔连接给了我超过 2*31 的行并且不起作用。我重写了 data.table 中的所有内容，它实际上将运行速度降低了几天。我发现如果我可以让这条线返回所需的结果，我可以创建一个 for 循环，查看“2013-02-01”和 500 个其他时间点并实现我的梦想（继续另一个问题）。下面的一个子集只需要 15 秒处理我的数据（所以我可以在几个小时内运行它），但我的问题是它只返回具有值子集的组。 ID:2 没有返回，我认为，因为该组在 i 中没有匹配项。 - 减少花在操作上的时间。

lsr[eksd <= as.Date("2013-02-01") & ENDDATE > as.Date("2013-02-01"), sum(as.numeric(ENDDATE - as.Date("2013-02-01"))), keyby = ID]


    ID V1
1:  1 64
2:  3 63

在大多数情况下这很聪明，但我需要有关长度 = 0 的组的信息。（或任何值 - 我只需要不删除 ID 信息）。有点像这样：

   ID V1
1:  1 64
2:  2 0
3:  3 63

我尝试使用 tidyr::complete 函数（如下所述：dplyr summarise: Equivalent of ".drop=FALSE" to keep groups with zero length in output），但 dplyr 太慢了。我的 0.2% 的数据需要 7 个小时。我相信这可以以某种方式实现。欢迎和赞赏任何建议。

Answer 1

问题是您在选择过程中删除了所有ID 为2 的情况。

作为替代方案，您可以将选择放在总和中，例如

lsr[, sum((eksd <= as.Date("2013-02-01") & ENDDATE > as.Date("2013-02-01")) *
           as.numeric(ENDDATE - as.Date("2013-02-01"))), keyby = ID]

给予

   ID V1
1:  1 64
2:  2  0
3:  3 63

Answer 2

出于速度原因，我建议您坚持第一种方法并简单地添加必要的零：

by_minem <- function(dt = lsr2) {
  x <- dt[eksd <= as.Date("2013-02-01") & ENDDATE > as.Date("2013-02-01"),
          sum(as.numeric(ENDDATE - as.Date("2013-02-01"))), keyby = ID]
  uid <- unique(dt$ID)
  id2 <- uid[!(uid %in% x$ID)]
  x2 <- data.table(ID = id2, V1 = 0)
  x <- rbind(x, x2)
  setkey(x, ID)
  x
}
by_minem(lsr)
#    ID V1
# 1:  1 64
# 2:  2  0
# 3:  3 63

测试更大的数据：

#Create larger data:
n <- 5e4
lsr2 <- lapply(1:n, function(x) lsr)
lsr2 <- rbindlist(lsr2, use.names = T, fill = T, idcol = T)
lsr2[, ID := as.integer(paste0(.id, ID))]
lsr2[, .(.N, uniqueN(ID))]
#         N     V2
# 1: 400000 150000

by_henry <- function(dt = lsr2) {
  dt[, sum((eksd <= as.Date("2013-02-01") & ENDDATE > as.Date("2013-02-01")) *
            as.numeric(ENDDATE - as.Date("2013-02-01"))), keyby = ID]
}

system.time(r1 <- by_henry()) #92.53
system.time(r2 <- by_minem()) #21.73
92.53/21.73 #4 times faster
all.equal(r1, r2)
# [1] TRUE

更新

这样会更快：

    by_minem2 <- function(dt = lsr2) {
  d <- as.numeric(as.Date("2013-02-01"))
  dt[, ENDDATE2 := as.numeric(ENDDATE)]
  x <- dt[eksd <= d & ENDDATE > d, sum(ENDDATE2 - d), keyby = ID]
  uid <- unique(dt$ID)
  id2 <- setdiff(uid, x$ID)
  id2 <- uid[!(uid %in% x$ID)]
  x2 <- data.table(ID = id2, V1 = 0)
  x <- rbind(x, x2)
  setkey(x, ID)
  x
}

system.time(r2 <- by_minem2()) #0.13

Answer 3

OP 已询问如何填写在上次聚合期间丢失的 IDs。

在不考虑与 OP 的聚合代码相关的性能问题的情况下，完成IDs 的一种方法是加入唯一的IDs，直接与上一个操作链接：

uid <- sort(unique(lsr$ID))
# OP's code
lsr[eksd <= as.Date("2013-02-01") & ENDDATE > as.Date("2013-02-01"), 
    sum(as.numeric(ENDDATE - as.Date("2013-02-01"))), keyby = ID][
      # chained with join to complete IDs
      .(ID = uid), on = "ID"][is.na(V1), V1 := 0][]

   ID V1
1:  1 64
2:  2  0
3:  3 63