R语言实现按分组为现有日期间隔补全缺失区间行
问题描述
现有一份包含起止日期的区间类型数据集,目标是按分组维度为数据集新增行,呈现各分组下区间之间存在的潜在空白间隔。该问题的复杂度在于:已有的区间可能存在重叠情况,且空白间隔的数量不固定。
场景示例
以公寓租住场景为例,数据中的起止日期记录了住户租住公寓的时间范围,同一公寓可能同时有多名住户入住,需要补充对应行来标记公寓处于“空置”状态的时间段。
示例数据
example_dates <- structure(list(apartment = c("A", "A", "A", "A", "B", "B", "B", "C", "C", "C"), start_date = structure(c(1640995200, 1642291200, 1649980800, 1655769600, 1644451200, 1646092800, 1659312000, 1646438400, 1649376000, 1664582400), class = c("POSIXct", "POSIXt"), tzone = "UTC"), end_date = structure(c(1642204800, 1648166400, 1655683200, 1668643200, 1655251200, 1653868800, 1667260800, 1654819200, 1661385600, 1668470400), class = c("POSIXct", "POSIXt"), tzone = "UTC"), status = c("person in apartment", "person in apartment", "person in apartment", "person in apartment", "person in apartment", "person in apartment", "person in apartment", "person in apartment", "person in apartment", "person in apartment")), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -10L))
期望输出结果
desired_outcome <- structure(list(apartment = c("A", "A", "A", "A", "A", "B", "B", "B", "B", "C", "C", "C", "C"), start_date = structure(c(1640995200, 1642291200, 1648252800, 1649980800, 1655769600, 1644451200, 1646092800, 1655337600, 1659312000, 1646438400, 1649376000, 1661472000, 1664582400), class = c("POSIXct", "POSIXt"), tzone = "UTC"), end_date = structure(c(1642204800, 1648166400, 1649894400, 1655683200, 1668643200, 1655251200, 1653868800, 1659225600, 1667260800, 1654819200, 1661385600, 1664496000, 1668470400), class = c("POSIXct", "POSIXt"), tzone = "UTC"), status = c("person in apartment", "person in apartment", "apartment empty", "person in apartment", "person in apartment", "person in apartment", "person in apartment", "apartment empty", "person in apartment", "person in apartment", "person in apartment", "apartment empty", "person in apartment" )), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -13L))
实现方案
核心处理逻辑为:先按分组维度合并所有重叠、相邻的有效区间,消除区间重叠的干扰;再提取合并后区间之间的空白段,标记为空置状态后与原始数据合并、按时间排序即可。基于R实现的可复用代码如下,依赖dplyr、lubridate、purrr包:
library(dplyr) library(lubridate) library(purrr) fill_interval_gaps <- function(df, group_col, start_col, end_col, status_col, empty_label = "apartment empty") { df %>% group_split({{group_col}}) %>% map_dfr(function(current_group) { # 生成分组内所有时间区间 all_intervals <- interval( start = pull(current_group, {{start_col}}), end = pull(current_group, {{end_col}}) ) # 合并所有重叠、相邻的区间 merged_intervals <- int_flatten(all_intervals) merged_intervals <- merged_intervals[order(int_start(merged_intervals))] # 遍历合并后的区间,提取中间的空白段 gap_rows <- list() if (length(merged_intervals) >= 2) { for (i in 2:length(merged_intervals)) { prev_end <- int_end(merged_intervals[i-1]) curr_start <- int_start(merged_intervals[i]) # 存在大于0的间隔才生成空置记录,日期偏移1天避免端点重合 if (curr_start > prev_end) { gap_rows[[length(gap_rows) + 1]] <- tibble( "{{status_col}}" := empty_label, "{{start_col}}" := prev_end + days(1), "{{end_col}}" := curr_start - days(1) ) } } } # 合并原始记录和空置记录,按起始时间排序 bind_rows(current_group, bind_rows(gap_rows)) %>% arrange({{start_col}}) }) } # 调用函数处理示例数据 final_result <- fill_interval_gaps( df = example_dates, group_col = apartment, start_col = start_date, end_col = end_date, status_col = status ) # 校验结果与期望输出完全一致 all.equal(final_result, desired_outcome)
运行后all.equal返回TRUE即说明输出结果完全匹配需求。如果是其他时间粒度(比如小时级)的区间,只需将代码中days(1)替换为对应粒度的偏移量即可。
内容的提问来源于stack exchange,提问作者Fred
相关产品推荐
相关产品推荐

