R语言按ID迭代修正供应日期：解决日期重叠计算误差问题

原始数据 #

library(dplyr)

# Create the dataframe
df <- data.frame(
  id = c('A', 'A', 'A', 'B', 'C', 'C', 'C', 'C', 'D', 'D', 'D'),
  supply_start_date = as.Date(c('2024-01-01', '2024-01-20', '2024-04-20', '2024-01-02', '2018-03-01', '2018-07-03', '2018-10-07', '2019-01-23', '2017-04-28', '2017-05-26', '2017-06-06')),
  supply_qty = c(30, 60, 100, 100, 100, 100, 100, 100, 30, 30, 30)
)

需求说明 #

• 生成原始供应结束日期：supply_end_date = supply_start_date + supply_qty - 1
• 按ID分组修正日期：若当前行的原始供应起始日期早于上一行修正后的供应结束日期，则将当前行的新起始日期设为上一行修正后的结束日期+1，再重新计算新结束日期；无重叠则保留原始起始和结束日期

现有代码及问题 #

尝试的代码如下：

# Add supply_end column
df <- df %>%
  mutate(supply_end_date=  supply_start_date + ( supply_qty - 1))

df2<-df %>% 
  arrange(id, supply_start_date) %>% 
  group_by(id) %>% 
  mutate(new_supply_start_date=as.Date(ifelse(row_number()>1 & (supply_start_date<=lag(supply_end_date,default = first(supply_end_date))+supply_qty-1),
         lag(supply_end_date,default=first(supply_end_date)+1),
         supply_start_date)),
         new_supply_end_date=as.Date(new_supply_start_date+supply_qty-1)) %>% 
  ungroup()
df2

问题在于：mutate是基于原始的supply_end_date批量计算，没有迭代使用上一行修正后的日期，导致后续行的计算错误。例如ID为D的最后一行，现有代码得到的new_supply_start_date为2017-06-24，不符合迭代修正的逻辑。

解决方案 #

使用dplyr结合purrr的accumulate函数实现逐行迭代修正，每一行的计算都依赖上一行修正后的结果：

library(dplyr)
library(purrr)

# 先计算原始供应结束日期
df <- df %>%
  mutate(supply_end_date = supply_start_date + supply_qty - 1)

# 迭代修正日期
df_fixed <- df %>%
  arrange(id, supply_start_date) %>%
  group_by(id) %>%
  mutate(
    # 用accumulate逐行生成修正后的起始和结束日期列表
    corrected_dates = accumulate(seq(n()), function(prev_result, row_idx) {
      if (row_idx == 1) {
        # 第一行直接使用原始日期
        list(
          start = supply_start_date[row_idx],
          end = supply_end_date[row_idx]
        )
      } else {
        current_raw_start <- supply_start_date[row_idx]
        prev_corrected_end <- prev_result$end
        
        # 判断是否需要修正
        if (current_raw_start <= prev_corrected_end) {
          new_start <- prev_corrected_end + 1
          new_end <- new_start + supply_qty[row_idx] - 1
          list(start = new_start, end = new_end)
        } else {
          # 无重叠，保留原始日期
          list(
            start = current_raw_start,
            end = current_raw_start + supply_qty[row_idx] - 1
          )
        }
      }
    }),
    # 从列表中提取日期列
    new_supply_start_date = as.Date(sapply(corrected_dates, `[[`, "start")),
    new_supply_end_date = as.Date(sapply(corrected_dates, `[[`, "end"))
  ) %>%
  ungroup() %>%
  # 按需选择保留的列
  select(id, supply_start_date, supply_qty, supply_end_date, new_supply_start_date, new_supply_end_date)

# 查看结果
print(df_fixed)

结果验证（ID为D的行） #

• 第一行：修正后起始2017-04-28，结束2017-05-27（原始日期）
• 第二行：原始起始2017-05-26早于第一行修正后的结束2017-05-27，修正后起始2017-05-28，结束2017-06-26
• 第三行：原始起始2017-06-06早于第二行修正后的结束2017-06-26，修正后起始2017-06-27，结束2017-07-25

该逻辑完全符合迭代修正的要求，解决了批量计算导致的误差问题。

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