R语言同客户合同区间重叠数统计的高效准确方案问询

我正在R中处理这份合同数据，前6行数据（不含write.csv函数自动新增的首列）如下：

> head(my_data)
client_id contract_id contract_start contract_end inter_complex
        1           1     15/07/2019   15/07/2020  18092+18458i
        3           3      1/01/2015    1/01/2015  16436+16436i
        5           5     12/06/2020   12/06/2020  18425+18425i
       13          13      1/01/2015    1/01/2015  16436+16436i
       18          18      1/01/2015    1/01/2015  16436+16436i
       19          19      1/01/2015    1/01/2015  16436+16436i

每行对应一份独立合同。变量inter_complex为复数类型，其实部是合同起始日期的数值表示，虚部对应合同结束日期的数值表示，可通过以下代码生成该列：

library(tidyverse)
library(lubridate)

chars_2_cplex = function(start, end) {
    cbind(start, end) %>%
    apply(2, compose(as.numeric, dmy)) %*% rbind(1, 1i)
}

my_data %>% transmute(inter_complex = chars_2_cplex(contract_start, contract_end))

我的核心需求是：按client_id分组，为每个合同计算同客户下与该合同区间重叠的合同总数量，新增simultaneous字段存储结果。即该字段表示对应合同有效期内，同客户同时生效的合同总数，若没有其他重叠合同，simultaneous取值为1，代表该时间段内仅当前合同有效。

我最初的实现思路是枚举inter_complex的所有组合，将复数转换为interval后调用lubridate的intersect函数判断是否重叠，编写代码如下：

## 该函数将复数转换为interval类型
cplex_2_inter = function(x) {
    start = x %>% Re() %>% as.integer()
    end = x %>% Im() %>% as.integer()

    interval(as_date(start), as_date(end))
}


## 该函数返回列表，第j个元素对应j+1个区间组合的交集判断结果
get_intersections = function(x) {
    max_m = length(x)
    output = vector(mode = "list", length = max_m - 1)

    for (i in 2:max_m) {
        output[[i - 1]] = combn(x, m = i) %>% t() %>% as.data.frame() %>% 
                          mutate_all(cplex_2_inter) %>% rowid_to_column("id") %>%
                          pivot_longer(-id) %>% group_by(id) %>% 
                          mutate(simultaneous = do.call(lubridate::intersect, as.list(value))) %>%
                          mutate(simultaneous = if_else(as.character(simultaneous) != "NA--NA", i, 1L))
    }

    return(output)
}

可运行以下示例代码理解get_intersections的功能：

example = my_data %>% filter(client_id == 1) %>% pull(inter_complex) %>% get_intersections()

数据框example[[1]]对应2个区间组合的重叠（overlaps）判断结果，example[[2]]对应3个区间组合的重叠判断结果，以此类推。可以看到同一个区间在不同组合中会对应不同的simultaneous值，最终需要为每个区间取最高的simultaneous值。

我目前按客户分组执行的代码效率极低，已经运行超过1天仍未完成：

my_data %>% group_by(client_id) %>% group_map(~ get_intersections(.x$inter_complex))

现有两个问题需要帮助解决：

• 我了解到区间树可高效处理这类区间重叠统计问题，但缺乏相关实现经验，希望得到更智能的高性能解决方案；
• 如果沿用现有组合枚举方案，需要编写函数从get_intersections返回的列表中提取每个区间对应的最高simultaneous值。

补充说明 #

我测试了现有Wimpel给出的data.table方案，发现部分样本计算结果有误：

> DT %>% filter(client_id == 502 & contract_id == 3093) %>%
> select(contract_start, contract_end, contract_intersect)
# 输出
   contract_start contract_end contract_intersect
1:     2018-01-11   2019-01-11                  7

该方案判定上述合同仅与同客户7份其他合同重叠，但用我的组合方案验证结果如下：

combs_10_502 = my_data %>% filter(client_id == 502) %>% pull(inter_complex) %>% 
               combn(10) %>% t() %>% as.data.frame() %>% mutate_all(cplex_2_inter) %>% 
               rowid_to_column("id") %>% pivot_longer(-id) %>% group_by(id) %>% 
               mutate(simultaneous = do.call(lubridate::intersect, as.list(value))) %>% 
               ungroup() %>% 
               mutate(simultaneous = if_else(as.character(simultaneous) != "NA--NA", 10L, 1L))    

> combs_10_502 %>% filter(simultaneous == 10) %>% slice(11:20)
# A tibble: 10 x 4
  id    name  value                          simultaneous
  <int> <chr> <Interval>                            <int>
1  24311 V1    2018-01-11 UTC--2019-01-11 UTC        10
2  24311 V2    2018-03-01 UTC--2019-03-01 UTC        10
3  24311 V3    2018-07-11 UTC--2019-07-11 UTC        10
4  24311 V4    2018-04-20 UTC--2019-04-20 UTC        10
5  24311 V5    2018-05-21 UTC--2019-05-21 UTC        10
6  24311 V6    2018-08-10 UTC--2019-08-10 UTC        10
7  24311 V7    2018-08-09 UTC--2019-08-09 UTC        10
8  24311 V8    2018-09-27 UTC--2019-09-27 UTC        10
9  24311 V9    2020-01-03 UTC--2021-01-03 UTC        10
10 24311 V10   2019-12-19 UTC--2020-12-19 UTC        10

可以看到该合同实际与同客户9份其他合同重叠，总共有10份同期有效合同。我希望获得基于data.table的高性能且计算结果准确的实现方案。

内容的提问来源于stack exchange，提问作者Werther