问题描述
我正在 R 上使用 these data。这些是前六行——不包括 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))
我想要的是，对于每个客户 ID 和每个合同，确定与同一客户 ID 关联的合同有多少与该合同相交。 换句话说：我想创建一个新列称为同时，它将为每一行描述——即对于每份合约——在当前合约有效的同一时期内，相应客户拥有多少有效合约。 如果没有发现给定合约与任何其他合约的交集，则 simultaneous 的值必须为 1——因为当该合约处于活动状态时，它也是各自客户拥有的唯一有效合同——。
我认为获得inter_complex的组合会有所帮助，然后将这些复数组合变成区间组合，然后使用lubridate的intersect函数来辨别每个区间组合是否相交.为此，我编写了以下代码：
## This function turns complex numbers into intervals.
cplex_2_inter = function(x) {
start = x %>% Re() %>% as.integer()
end = x %>% Im() %>% as.integer()
interval(as_date(start),as_date(end))
}
## This other function returns a list whose j-th element is a data frame that shows the interceptions
## between combinations of j + 1 intervals.
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]] 显示了间隔对之间是否存在截取——或者，更准确地说，重叠。数据框 example[[2]] 显示三个区间的组之间是否存在重叠，依此类推。
您可能会注意到，根据 example[[1]]，区间 2019-07-15 UTC--2020-07-15 UTC 与其他某个区间重叠，因此， simultaneous 是 2——而根据 example[[2]]，这个区间与变量 simultaneous 的值 3 相关联。 当然，我们的想法是为每个间隔分配其最高的同时值。
因为我不关心全局重叠，而是关心每个客户端 ID 内的重叠，所以我认为我需要处理分组数据框。我在这个项目上得到的最远的是写这个：
my_data %>% group_by(client_id) %>% group_map(~ get_intersections(.x$inter_complex))
现在开始我的问题。 1) 我已经执行了上面的行，但是这个过程不是很有效。它已经运行了一天多一点，还没有完成。最近我遇到了区间树的概念，但我不是计算机科学家，我需要帮助才能以更聪明的方式解决这个问题。 2) 如果我们坚持我不太聪明的方法来解决这个问题，我仍然需要一个函数来访问由 get_intersections 返回的列表中的每个元素，以便识别和检索与每个间隔相关联的最高同时值。在这件事上，我也必须请求帮助。
编辑
关于 Wimpel 的回答，我检查了他们的数据表，我发现了这个。
> DT %>% filter(client_id == 502 & contract_id == 3093) %>%
> select(contract_start,contract_end,contract_intersect)
# Output
contract_start contract_end contract_intersect
1: 2018-01-11 2019-01-11 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
相同的合约显示在上面tibble 的第一行。可以看出，该合约实际上与给定客户的九个其他合约重叠——这九个显示在剩余的行上——。
我不知道 Wimpel 的解决方案是如何出错的，但我检查过它确实为其他几个合同提供了正确的交叉点数量。现在我知道我正在寻找基于数据表的解决方案，因为流程非常快，但建议的解决方案似乎存在问题。
解决方法
我相信您正在寻找这样的东西？
library(data.table)
DT <- fread("https://raw.githubusercontent.com/pazos-feren/Data/main/contracts.csv")
#set dates as real dates
DT[,contract_start := as.Date(contract_start,format = "%d/%m/%Y")]
DT[,contract_end := as.Date(contract_end,format = "%d/%m/%Y")]
setkey(DT,V1)
DT[DT,c("contract_intersect","contract_intersect_ids") := {
val = DT[ !V1 == i.V1 & client_id == i.client_id &
contract_start <= i.contract_end & contract_end >= i.contract_start,]
list( nrow(val),paste0(val$contract_id,collapse = ";") )
},by = .EACHI]
# V1 client_id contract_id contract_start contract_end inter_complex contract_intersect contract_intersect_ids
# 1: 1 1 1 2019-07-15 2020-07-15 18092+18458i 2 4162;4168
# 2: 2 3 3 2015-01-01 2015-01-01 16436+16436i 0
# 3: 3 5 5 2020-06-12 2020-06-12 18425+18425i 0
# 4: 4 13 13 2015-01-01 2015-01-01 16436+16436i 0
# 5: 5 18 18 2015-01-01 2015-01-01 16436+16436i 0
# 6: 6 19 19 2015-01-01 2015-01-01 16436+16436i 0