基于Tidyverse的索引天数时间区间桥接优化方案求助

问题背景 #

我有包含起始日期（索引天数）、结束日期（索引天数）和分组列的数据，需要按分组处理：当某条记录的结束日期与下一条记录的起始日期相差≤50天时，修改该结束日期实现时间区间的“桥接”。

示例数据 #

library(tidyverse)
df <- structure(list(effective_time_from_index_start = c(373, 569, 932, 1280, 1410, 1610, 20, 80, NA, 140),
                     effective_time_from_index_end = c(520,  883, 1233, 1387, 1624, NA, 40, 100, 120, NA),
                     group = c(1,1,1,2,2,2,3,3,3,3)),
                row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))
df
#> # A tibble: 10 × 3
#>    effective_time_from_index_start effective_time_from_index_end group
#>                              <dbl>                         <dbl> <dbl>
#>  1                             373                           520     1
#>  2                             569                           883     1
#>  3                             932                          1233     1
#>  4                            1280                          1387     2
#>  5                            1410                          1624     2
#>  6                            1610                            NA     2
#>  7                              20                            40     3
#>  8                              80                           100     3
#>  9                              NA                           120     3
#> 10                             140                            NA     3

期望输出 #

# 先得到桥接后的全量数据
desired_df <- df %>%
  group_by(group) %>%
  mutate(effective_time_from_index_end = ifelse(
    is.na(lead(effective_time_from_index_end)) |
    effective_time_from_index_end <
      lead(effective_time_from_index_start, default = 9999) - 50,
    effective_time_from_index_end,
    lead(effective_time_from_index_end)
  )) %>%
  mutate(effective_time_from_index_end = ifelse(
    is.na(lead(effective_time_from_index_end)) |
      effective_time_from_index_end <
      lead(effective_time_from_index_start, default = 9999) - 50,
    effective_time_from_index_end,
    lead(effective_time_from_index_end)
  )) %>%
  mutate(effective_time_from_index_end = ifelse(
    is.na(lead(effective_time_from_index_end)) |
      effective_time_from_index_end <
      lead(effective_time_from_index_start, default = 9999) - 50,
    effective_time_from_index_end,
    lead(effective_time_from_index_end)
  ))
desired_df
#> # A tibble: 10 × 3
#> # Groups:   group [3]
#>    effective_time_from_index_start effective_time_from_index_end group
#>                              <dbl>                         <dbl> <dbl>
#>  1                             373                          1233     1
#>  2                             569                          1233     1
#>  3                             932                          1233     1
#>  4                            1280                          1624     2
#>  5                            1410                          1624     2
#>  6                            1610                            NA     2
#>  7                              20                           100     3
#>  8                              80                           100     3
#>  9                              NA                           120     3
#> 10                             140                            NA     3

# 再筛选出每个分组的最小起始日期对应的桥接区间
final_desired_df <- desired_df %>%
  filter(effective_time_from_index_start == min(effective_time_from_index_start, na.rm = TRUE))
final_desired_df
#> # A tibble: 3 × 3
#> # Groups:   group [3]
#>   effective_time_from_index_start effective_time_from_index_end group
#>                             <dbl>                         <dbl> <dbl>
#> 1                             373                          1233     1
#> 2                            1280                          1624     2
#> 3                              20                           100     3

现有方案问题 #

当前通过重复调用mutate+ifelse的方式实现，代码冗余且健壮性差——如果分组内有更多需要桥接的连续区间，需要手动增加更多mutate步骤，无法自适应处理任意长度的连续桥接场景。

优化方案 #

1. Tidyverse 方案（推荐） #

核心思路：先标记每个分组内需要桥接的连续区间，再将每个连续区间的结束日期统一替换为该区间的最大结束日期，同时保留原始NA值。

df %>%
  group_by(group) %>%
  # 标记桥接组：当前记录与下一条间隔>50/含NA则新建组，否则归为同一组
  mutate(bridge_group = cumsum(
    is.na(effective_time_from_index_start) | 
    is.na(effective_time_from_index_end) |
    lead(effective_time_from_index_start, default = Inf) - effective_time_from_index_end > 50
  )) %>%
  # 每个桥接组内统一替换结束日期
  mutate(effective_time_from_index_end = ifelse(
    !is.na(effective_time_from_index_end),
    max(effective_time_from_index_end, na.rm = TRUE),
    NA
  ), .by = c(group, bridge_group)) %>%
  # 移除临时列
  select(-bridge_group) %>%
  ungroup() -> optimized_df

# 查看桥接后的全量数据
optimized_df

# 筛选最终结果
optimized_df %>%
  group_by(group) %>%
  filter(effective_time_from_index_start == min(effective_time_from_index_start, na.rm = TRUE)) %>%
  ungroup() -> final_optimized_df

final_optimized_df

2. data.table 方案 #

适合大数据量场景，处理效率更高：

library(data.table)
setDT(df)

# 标记桥接组
df[, bridge_group := cumsum(
  is.na(effective_time_from_index_start) | 
  is.na(effective_time_from_index_end) |
  shift(effective_time_from_index_start, type = "lead", fill = Inf) - effective_time_from_index_end > 50
), by = group]

# 替换结束日期
df[, effective_time_from_index_end := ifelse(
  !is.na(effective_time_from_index_end),
  max(effective_time_from_index_end, na.rm = TRUE),
  NA
), by = .(group, bridge_group)]

# 移除临时列
df[, bridge_group := NULL]

# 筛选最终结果
final_dt_df <- df[, .SD[effective_time_from_index_start == min(effective_time_from_index_start, na.rm = TRUE)], by = group]
final_dt_df

方案说明 #

• 两种方案都能自适应处理任意长度的连续桥接区间，无需手动重复调用处理逻辑
• 保留了原始数据中的NA值，不需要提前剔除NA再处理
• Tidyverse方案更贴合常规数据分析流程，data.table方案适合大数据量场景

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