【问题标题】：Calculating active days/months from overlapping dates从重叠日期计算活动天数/月数
【发布时间】：2017-11-26 23:37:17
【问题描述】：

我有为大量客户列出不同产品的开始和结束日期的数据。不同产品的购买间隔可能重叠或有时间间隔：

library(lubridate)
library(Hmisc)
library(dplyr)

user_id <- c(rep(12, 8), rep(33, 5))

start_date <- dmy(Cs(31/10/2010,    18/12/2010, 31/10/2011, 18/12/2011, 27/03/2014, 18/12/2014, 27/03/2015, 18/12/2016, 01/07/1992, 20/08/1993, 28/10/1999, 31/01/2006, 26/08/2016))

end_date <- dmy(Cs(31/10/2011,  18/12/2011, 28/04/2014, 18/12/2014, 27/03/2015, 18/12/2016, 27/03/2016, 18/12/2017,
               01/07/2016,  16/08/2016, 15/11/2012, 28/02/2006, 26/01/2017))

data <- data.frame(user_id, start_date, end_date)

data
   user_id start_date   end_date
1       12 2010-10-31 2011-10-31
2       12 2010-12-18 2011-12-18
3       12 2011-10-31 2014-04-28
4       12 2011-12-18 2014-12-18
5       12 2014-03-27 2015-03-27
6       12 2014-12-18 2016-12-18
7       12 2015-03-27 2016-03-27
8       12 2016-12-18 2017-12-18
9       33 1992-07-01 2016-07-01
10      33 1993-08-20 2016-08-16
11      33 1999-10-28 2012-11-15
12      33 2006-01-31 2006-02-28
13      33 2016-08-26 2017-01-26

我想计算他/她持有任何产品的总活跃天数或总月数。

如果产品总是重叠，那不是问题，我可以简单地服用

data %>% 
group_by(user_id) %>% 
dplyr::summarize(time_diff = max(end_date) - min(start_date))

但是，正如您在用户 33 中看到的那样，产品并不总是重叠，它们的间隔必须单独添加到所有“重叠”间隔中。

是否有一种快速而优雅的编码方式，希望在dplyr 中？

【问题讨论】：

感谢 @J_F 为我的代码添加适当的包！
我没有看到 product_id。如果每行包含不同的产品，那么在您的具体示例中，客户将没有持有所有产品的日子。还是我误会了你？
嗨@Edwin，也许我的产品类型在这里无关紧要，我只是想计算用户持有任何产品的总活跃天数。我会编辑我的帖子，因为我的措辞可能有点误导！

标签： r date data.table dplyr

【解决方案1】：

使用IRanges 和intersect 怎么样？

library(IRanges)
data %>% 
  group_by(user_id) %>% 
  summarise(days_held=sum(width(reduce(IRanges(as.numeric(start_date), as.numeric(end_date)))))) 
# A tibble: 2 × 2
  user_id active_days
    <dbl>       <int>
1      12        2606
2      33        8967

这里使用 Nathan Wert 的 big_data 进行基准测试。 IRange 方法似乎要快一些。

my_result <- function(x) {
x %>% 
    group_by(user_id) %>% 
    summarise(days_held=sum(width(reduce(IRanges(as.numeric(start_date), as.numeric(end_date)))))) 
}


library(microbenchmark)
microbenchmark(
  a <- my_result(big_data),
  b <- my_answer(big_data), times=2
)
Unit: seconds
                     expr      min       lq     mean   median       uq      max neval cld
 a <- my_result(big_data) 14.97008 14.97008 14.98896 14.98896 15.00783 15.00783     2  a 
 b <- my_answer(big_data) 17.59373 17.59373 17.76257 17.76257 17.93140 17.93140     2   b

all.equal(a, b)
[1] TRUE

编辑

要可视化范围，您还可以绘制数据...

library(Gviz)
library(GenomicRanges)
a <- sapply(split(data, data$user_id), function(x) {
  AnnotationTrack(start = as.numeric(x$start_date), end = as.numeric(x$end_date),
                  chromosome = "chrNA", stacking = "full", name = as.character(unique(x$user_id)))
})
plotTracks(trackList = a)

【讨论】：

【解决方案2】：

我们可以使用dplyr 中的函数来计算总天数。以下示例扩展每个时间段，然后删除重复的日期。最后统计每个user_id的总行数。

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

【讨论】：

这正是我所追求的，谢谢@ycw！不过，一个简单的问题，因为您正在扩展数据框中的每个区间，是否可以将其有效地应用于大数据集（数百万用户）？
@KasiaKulma 我不知道它是否能有效地处理大数据。你可能想测试一下。
@yvc，我在更大的数据上测试它，大约 18k 行。您的代码将运行 6%，然后停止返回以下错误：Error in seq.int(0, to0 - from, by) : wrong sign in 'by' argument，知道是什么原因造成的吗？我们说话的时候我正在疯狂地搜索，但到目前为止还没有运气......
没关系，我解决了！原来我有一些行 end_date

【解决方案3】：

制作data.frame 效率不高，因此您可以通过将范围保持为Date 向量来节省时间。

multi_seq_date <- Vectorize(seq.Date, c('from', 'to'), SIMPLIFY = FALSE)

data %>%
  group_by(user_id) %>%
  mutate(date_seq = multi_seq_date(start_date, end_date, by = 'day')) %>%
  summarise(days_held = length(unique(unlist(date_seq))))

我确信有一种更惯用的 tidyverse 方式来编写它，但我不是一个 tidyverse 人。

multi_seq_date 将返回日期序列列表。然后，只需计算该列表中的独特天数即可。我在一个随机生成的大型样本集上运行了这个和 ycw 的答案：

# Making the data -----------------------------------
big_size <- 100000
starting_range <- seq(dmy('01-01-1990'), dmy('01-01-2017'), by = 'day')

set.seed(123456)
big_data <- data.frame(
  user_id    = sample(seq_len(round(big_size / 4)), big_size, replace = TRUE),
  start_date = sample(starting_range, big_size, replace = TRUE)
)
big_data$end_date <- big_data$start_date + round(runif(big_size, 1, 500))


# The actual process to test -------------------------
my_answer <- function(x) {
  multi_seq_date <- Vectorize(seq.Date, c('from', 'to'), SIMPLIFY = FALSE)
  x %>%
    group_by(user_id) %>%
    mutate(date_seq = multi_seq_date(start_date, end_date, by = 'day')) %>%
    summarise(days_held = length(unique(unlist(date_seq))))
}

在我的电脑上，my_answer 花了大约 13 秒。

【讨论】：