使用data.table计算重叠日期的活动天数

时间:2017-07-03 14:13:49

标签: r date data.table lubridate

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

非常感谢你的帮助!

3 个答案:

答案 0 :(得分:5)

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)写上一篇文章的功能:

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

尚未完成......

UPDATE:

6)如果我们首先将日期转换为integer,我们可以大大提高速度。我的方法是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

UPDATE2:

9)单独执行unlistuniqueN是错误的,如果我们在一次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

UPDATE3:

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

答案 1 :(得分:2)

如果我理解您的问题,即计算每个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

答案 2 :(得分:1)

这种方法使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)
   ]