使用 data.table 从重叠日期计算活跃天数

Question

我正在尝试使用 data.table 包或其他有效处理大数据（14-22 百万行）的解决方案来解决我发布的问题。关于如何加快此解决方案或找到更快的解决方法的任何提示？

非常感谢您的帮助！

Answer 1

1) 让数据相乘：

d <- replicate(1e2, data, simplify = F)
d <- rbindlist(d, use.names = T, fill = T, idcol = T)
d[, user_id := paste0(user_id, .id)]
      .id user_id start_date   end_date
   1:   1     121 2010-10-31 2011-10-31
   2:   1     121 2010-12-18 2011-12-18
   3:   1     121 2011-10-31 2014-04-28
   4:   1     121 2011-12-18 2014-12-18
   5:   1     121 2014-03-27 2015-03-27
  ---                                  
1296: 100   33100 1992-07-01 2016-07-01
1297: 100   33100 1993-08-20 2016-08-16
1298: 100   33100 1999-10-28 2012-11-15
1299: 100   33100 2006-01-31 2006-02-28
1300: 100   33100 2016-08-26 2017-01-26

2) 从之前的 post:

写入函数

yourFunction <- function(data){
  data %>%
    rowwise() %>%
    do(data_frame(user_id = .$user_id, 
                  Date = seq(.$start_date, .$end_date, by = 1))) %>%
    distinct() %>%
    ungroup() %>%
    count(user_id)
}

rez1 <- yourFunction(d)
rez1
    # A tibble: 200 x 2
   user_id     n
     <chr> <int>
 1     121  2606
 2    1210  2606
 3   12100  2606
 4    1211  2606
 5    1212  2606
 6    1213  2606
 7    1214  2606
 8    1215  2606
 9    1216  2606
10    1217  2606
# ... with 190 more rows

3) 我的 data.table 方法：

myFunction <- function(data){
  setDT(data)
  seq2 <- Vectorize(seq.default, vectorize.args = c("from", "to"))
  data[, n:= seq2(start_date, end_date)]
  d <- data[, .(day = unlist(n)), by = user_id]
  d[, .(n = uniqueN(day)), by = user_id]
}
rez2 <- myFunction(d)

3) 测试结果是否相等：

setDT(rez1)
setorder(rez1, user_id)
setorder(rez2, user_id)
all.equal(rez1, rez2)
[1] TRUE

4) 基准：

cols <- c("test", "replications", "elapsed", "relative")
rbenchmark::benchmark(yourFunction(d),
                      myFunction(d), replications = 1, columns = cols)
             test replications elapsed relative
1 yourFunction(d)            1   10.23   42.625
2   myFunction(d)            1    0.24    1.000

5) 让我们尝试使用更大的数据：

d <- replicate(1e5, data, simplify = F)
d <- rbindlist(d, use.names = T, fill = T, idcol = T)
d[, .N]
[1] 1300000
d[, user_id := paste0(user_id, .id)]

system.time(rez3 <- myFunction(d))

还没写完....

更新：

6) 如果我们先将日期转换为integer，我们可以大大提高速度。我的方法 nr.2:

  myFunction2 <- function(data){
    setDT(data)
    seq2 <- Vectorize(seq.default, vectorize.args = c("from", "to"))
    startD <- as.integer(data[["start_date"]])
    endD <- as.integer(data[["end_date"]])
    seqences <- seq2(startD, endD)
    data[, n:= seqences]
    d <- data[, .(day = unlist(n)), by = user_id]
    d[, .(n = uniqueN(day)), by = user_id]
  }

7) 现在我们可以使用比以前更大的数据来压缩我的第一个函数：

d <- replicate(1e4, data, simplify = F)
d <- rbindlist(d, use.names = T, fill = T, idcol = T)
d[, user_id := paste0(user_id, .id)]
d[, .N]
[1] 130000
### BENCHMARK
                    test replications elapsed relative
2  rez1 <- myFunction(d)            1   91.19    7.657
1 rez2 <- myFunction2(d)            1   11.91    1.000
all.equal(rez1, rez2)
[1] TRUE

更新 2：

9) 单独执行 unlist 和 uniqueN 是错误的，如果我们将其组合在一个 data.table 调用中，我们将减少内存使用并将速度提高大约 3 -4次：

myFunction3 <- function(data){
    setDT(data)
    seq2 <- Vectorize(seq.default, vectorize.args = c("from", "to"))
    startD <- as.integer(data[["start_date"]])
    endD <- as.integer(data[["end_date"]])
    seqences <- seq2(startD, endD)
    data[, n:= seqences]
    data[, .(n = uniqueN(unlist(n))), by = user_id]
  }

rbenchmark::benchmark(rez2 <- myFunction2(d),
                      rez1 <- myFunction3(d), replications = 1, columns = cols)
                    test replications elapsed relative
2 rez1 <- myFunction3(d)            1    4.19    1.000
1 rez2 <- myFunction2(d)            1   14.06    3.356

10) ~~使用最后一种方法，我可以在大约 25 秒内处理 130 万行。~~

使用最后一种方法，我可以在大约 1 分钟内处理 78 万行（取决于内存）。

11) 原始与最后：（在 1300 行上）

             test replications elapsed relative
1 yourFunction(d)            1   10.22  340.667
2  myFunction3(d)            1    0.03    1.000

更新 3：

12）也许这个功能可以提高一点速度：

myFunction5 <- function(d){
  setDT(d)
  setkey(d, user_id)
  seq2 <- Vectorize(seq.default, vectorize.args = c("from", "to"))
  startD <- as.integer(d[["start_date"]])
  endD <- as.integer(d[["end_date"]])
  seqences <- seq2(startD, endD)
  dd <- d[, .(list(.I)), by = user_id]
  indlist <- dd[[2]]
  mf <- function(x) uniqueN(unlist(x))
  ff <- function(x) mf(seqences[x])
  ff2 <- Vectorize(ff, "x")
  r <- ff2(indlist)
  data.table(user_id = dd[[1]], n = r, key = "user_id")
}
             test replications elapsed relative
1  myFunction3(d)            1    3.71     1.22
2 myFunction4(d1)            1    3.04     1.00

Answer 2

此方法将 seq 保留在内部循环之外，但会导致内存不足的不幸后果，因此在大约 1e5 时崩溃。但根据您的 user_ids 和日期范围条目的数量，这可能会更快：

> d[, .SD
   ][, .(date=seq(from=min(start_date), to=max(end_date), by=1))
   ][d, .(user_id=i.user_id, start_date=i.start_date, end_date=i.end_date, date=x.date), on=.(date >= start_date, date <= end_date), allow.cartesian=T
   ][, unique(.SD, by=c('user_id', 'date'))
   ][, .N, user_id
   ][order(user_id)
   ]

Answer 3

如果我理解您的问题，即计算每个 ID 的唯一天数，则使用 Map 构建连续日期的替代方法是

setDT(data)[, .(cnt=uniqueN(unlist(Map(seq, start_date, end_date, by="day")))), by=user_id]
   user_id  cnt
1:      12 2606
2:      33 8967

使用 data.table 从重叠日期计算活跃天数

Calculating active days from overlapping dates using data.table

r

date

lubridate

data.table

更新：

更新 2：

更新 3：