如何在R中按contrato分组为fecha_pago列设置特定填充条件

数据与需求 #

现有数据框aux_nov，核心字段包括合同ID(contrato)、付款日期(fecha_pago)、跟踪日期(seguimiento_mes)，示例数据构造如下：

library(tibble)
aux_nov <- tibble(
  contrato = c(598047, 598047, 598047, 598047, 598047, 598047, 598047, 598047),
  fecha_pago = c(as.Date("2023-10-21"), NA, NA, NA, as.Date("2024-03-13"), as.Date("2024-04-02"), NA, NA),
  seguimiento_mes = rep(as.Date("2023-11-30"), 8)
)

填充规则：

• 当fecha_pago为NA时，查找当前合同内前一个有效付款日期
• 若前一个有效日期不存在（也是NA），则保持NA
• 若前一个有效日期大于seguimiento_mes，用该日期填充当前NA；否则仍为NA

原代码问题 #

之前尝试的循环未按contrato分组，导致跨合同ID填充错误：

last_valid_payment_date <- NULL

for (i in 1:nrow(aux_nov)) {
  if (is.na(aux_nov$fecha_pago[i])) {
    if (!is.na(last_valid_payment_date)) {
      if (last_valid_payment_date > aux_nov$seguimiento_mes[i]) {
        aux_nov$fecha_pago[i] <- last_valid_payment_date
      } else {
        aux_nov$fecha_pago[i] <- NA
      }
    }
  } else {
    if (aux_nov$fecha_pago[i] > aux_nov$seguimiento_mes[i]) {
      last_valid_payment_date <- aux_nov$fecha_pago[i]
    }
  }
}

正确实现方案 #

方法1：dplyr + zoo 分组处理（推荐） #

用dplyr分组确保每个合同独立处理，zoo::na.locf实现向前填充：

library(dplyr)
library(zoo)

aux_nov_processed <- aux_nov %>%
  group_by(contrato) %>%
  mutate(
    # 筛选出满足条件的有效付款日期
    valid_pago = if_else(fecha_pago > seguimiento_mes, fecha_pago, NA_Date_),
    # 向前填充最近的有效日期，保留开头的NA
    filled_pago = na.locf(valid_pago, na.rm = FALSE),
    # 合并原非NA值与填充后的值
    fecha_pago = case_when(
      !is.na(fecha_pago) ~ fecha_pago,
      !is.na(filled_pago) ~ filled_pago,
      TRUE ~ NA_Date_
    )
  ) %>%
  select(-valid_pago, -filled_pago) %>%
  ungroup()

# 查看结果
print(aux_nov_processed)

方法2：修正循环按分组处理 #

如果偏好循环实现，需按合同分组遍历，每个合同单独维护有效日期变量：

# 先按合同排序
aux_nov <- aux_nov %>% arrange(contrato)

# 初始化填充列
aux_nov$fecha_pago_filled <- aux_nov$fecha_pago

# 遍历每个合同
for (ct in unique(aux_nov$contrato)) {
  # 获取当前合同的行索引
  row_idx <- which(aux_nov$contrato == ct)
  last_valid <- NULL
  
  for (i in row_idx) {
    if (is.na(aux_nov$fecha_pago[i])) {
      if (!is.na(last_valid)) {
        aux_nov$fecha_pago_filled[i] <- ifelse(last_valid > aux_nov$seguimiento_mes[i], last_valid, NA_Date_)
      }
    } else {
      # 更新有效日期（仅当当前日期满足大于跟踪日期时）
      if (aux_nov$fecha_pago[i] > aux_nov$seguimiento_mes[i]) {
        last_valid <- aux_nov$fecha_pago[i]
      }
    }
  }
}

# 替换原字段并清理中间列
aux_nov$fecha_pago <- aux_nov$fecha_pago_filled
aux_nov <- aux_nov %>% select(-fecha_pago_filled)

期望输出 #

处理后的数据如下：

内容的提问来源于stack exchange，提问作者Brian Garcia Alvarez