R代码生成enddate精准回溯月变量时结果异常排查

我有命名为data2014至data2021的个体医疗使用数据集，每个个体有end_date（代码中变量名为limiet），范围在2014-2021年之间。需求是判断个体在end_date前第n个精准月份内是否接受过医疗服务：

• 例：若end_date为2018-06-09，1mte（距end_date最近的1个月）对应区间是2018-05-09至2018-06-09；2mte对应2018-04-09至2018-05-09，以此类推。
• 每个个体的年度医疗数据包含服务开始日期（BEGINDATUM_PRESTATIE_YYYY）、结束日期（EINDDATUM_PRESTATIE_YYYY），单年度内多条记录用分号分隔，需拆分处理。
• 需检查每个精准回溯月区间内是否有至少1天的医疗服务记录（有则标记Yes，否则No），回溯上限为2014-01-01，当前设置回溯60个月。

目前生成的回溯月起止区间符合end_date减n个月的规则，但除60mte外，其余变量值均为No或NA。此前使用日历月（如2015-01-01至2015-01-30）时代码可正常运行，现在切换为精准回溯月逻辑后出现异常，请求排查代码问题。

原代码 #

alle_jaren <- 2014:2021
start_boundary <- as.Date("2014-01-01")
max_months_back <- 60

for (jaar in alle_jaren) {

  dataset_naam <- paste0("data", jaar)

  df <- get(dataset_naam)

  result_list <- vector("list", nrow(df))

  for (r in seq_len(nrow(df))) {
    limiet <- as.Date(df$end_date[r])

    month_ends <- as.Date(character())
    current_end <- limiet

    months_back <- 0
    while (current_end >= start_boundary && months_back < max_months_back) {
      month_ends <- c(month_ends, as.Date(current_end))
      current_end <- as.Date(current_end %m-% months(1))
      months_back <- months_back + 1
    }
    
    month_starts <- month_ends %m-% months(1) + days(1)
    month_starts <- as.Date(month_starts)
    month_starts[month_starts < start_boundary] <- start_boundary
    
    month_starts <- rev(month_starts)
    month_ends <- rev(month_ends)

    n_months <- length(month_starts)
    maand_labels <- paste0(n_months:1, "mte")

    zorg_yesno <- rep("No", n_months)
    zorg_types <- rep(NA_character_, n_months)

    jaar_kolommen <- alle_jaren[alle_jaren <= jaar &&
                                  paste0("BEGINDATUM_PRESTATIE_", alle_jaren) %in% names(df)]

    for (j in jaar_kolommen) {
      beginkol <- paste0("BEGINDATUM_PRESTATIE_", j)
      eindkol  <- paste0("EINDDATUM_PRESTATIE_", j)
      prodkol  <- paste0("PRODUCTCODE_", j)

      begindata_raw <- df[[beginkol]][r]
      einddata_raw  <- df[[eindkol]][r]
      zorgtypes_raw <- df[[prodkol]][r]

      if (all(is.na(c(begindata_raw, einddata_raw, zorgtypes_raw)))) next

      begin_list <- str_split(begindata_raw, ";")[[1]]
      eind_list  <- str_split(einddata_raw, ";")[[1]]
      prod_list  <- str_split(zorgtypes_raw, ";")[[1]]

      begin_dates <- suppressWarnings(as.Date(begin_list, "%Y%m%d"))
      eind_dates  <- suppressWarnings(as.Date(eind_list, "%Y%m%d"))

      for (i in seq_along(begin_dates)) {
        if (is.na(begin_dates[i]) | is.na(eind_dates[i])) next

        for (m in seq_len(n_months)) {
          start_month <- as.Date(month_starts[m])
          end_month   <- as.Date(month_ends[m])
          
           if(begin_dates[i] <= end_month && eind_dates[i] >= start_month){
            zorg_yesno[m] <- "Yes"
            zorg_types[m] <- ifelse(
              is.na(zorg_types[m]),
              prod_list[i],
              paste0(zorg_types[m], ";", prod_list[i])
            )
          }
        }
      }
    }

    out <- setNames(
      c(zorg_yesno, zorg_types),
      c(paste0("zorg_", maand_labels), paste0("type_", maand_labels))
    )

    result_list[[r]] <- out
  }

  df <- bind_cols(df, bind_rows(result_list))
  assign(dataset_naam, df, envir = .GlobalEnv)
}

问题根源分析 #

1. 区间与标签错位：
   生成maand_labels时用了paste0(n_months:1, "mte")，同时对month_starts和month_ends执行了rev()反转操作，导致最旧的回溯月区间被标记为最大的n值（比如60mte），而最新的区间被标记为1mte，但循环匹配时，医疗记录的标记位置和标签实际指向的区间完全错位，导致你看到的近月区间全是No。

2. 遍历顺序逻辑混乱：
   反转区间后，遍历从最旧的区间开始，当医疗记录覆盖多个区间时，后续的新区间标记会覆盖旧的，但标签顺序反向，进一步加剧了显示异常。

修正后的代码 #

library(tidyverse)
library(lubridate)

alle_jaren <- 2014:2021
start_boundary <- as.Date("2014-01-01")
max_months_back <- 60

for (jaar in alle_jaren) {

  dataset_naam <- paste0("data", jaar)
  df <- get(dataset_naam)
  result_list <- vector("list", nrow(df))

  for (r in seq_len(nrow(df))) {
    limiet <- as.Date(df$end_date[r])

    # 生成从end_date往前的精准月份区间，保持从最近到最远的顺序，不反转
    month_ends <- as.Date(character())
    current_end <- limiet
    months_back <- 0
    
    while (current_end >= start_boundary && months_back < max_months_back) {
      month_ends <- c(month_ends, current_end)
      current_end <- current_end %m-% months(1)
      months_back <- months_back + 1
    }
    
    # 计算每个区间的起始日期
    month_starts <- month_ends %m-% months(1) + days(1)
    month_starts <- as.Date(month_starts)
    month_starts[month_starts < start_boundary] <- start_boundary
    
    # 按区间生成顺序（最近到最远）生成标签：1mte,2mte,...n_months mte
    n_months <- length(month_starts)
    maand_labels <- paste0(1:n_months, "mte")

    zorg_yesno <- rep("No", n_months)
    zorg_types <- rep(NA_character_, n_months)

    jaar_kolommen <- alle_jaren[alle_jaren <= jaar &&
                                  paste0("BEGINDATUM_PRESTATIE_", alle_jaren) %in% names(df)]

    for (j in jaar_kolommen) {
      beginkol <- paste0("BEGINDATUM_PRESTATIE_", j)
      eindkol  <- paste0("EINDDATUM_PRESTATIE_", j)
      prodkol  <- paste0("PRODUCTCODE_", j)

      begindata_raw <- df[[beginkol]][r]
      einddata_raw  <- df[[eindkol]][r]
      zorgtypes_raw <- df[[prodkol]][r]

      if (all(is.na(c(begindata_raw, einddata_raw, zorgtypes_raw)))) next

      begin_list <- str_split(begindata_raw, ";")[[1]]
      eind_list  <- str_split(einddata_raw, ";")[[1]]
      prod_list  <- str_split(zorgtypes_raw, ";")[[1]]

      begin_dates <- suppressWarnings(as.Date(begin_list, "%Y%m%d"))
      eind_dates  <- suppressWarnings(as.Date(eind_list, "%Y%m%d"))

      for (i in seq_along(begin_dates)) {
        if (is.na(begin_dates[i]) | is.na(eind_dates[i])) next

        # 遍历每个精准月份区间，匹配医疗记录
        for (m in seq_len(n_months)) {
          start_month <- month_starts[m]
          end_month   <- month_ends[m]
          
          # 检查医疗记录区间与当前回溯月是否有重叠
          if(begin_dates[i] <= end_month && eind_dates[i] >= start_month){
            zorg_yesno[m] <- "Yes"
            zorg_types[m] <- ifelse(
              is.na(zorg_types[m]),
              prod_list[i],
              paste0(zorg_types[m], ";", prod_list[i])
            )
          }
        }
      }
    }

    out <- setNames(
      c(zorg_yesno, zorg_types),
      c(paste0("zorg_", maand_labels), paste0("type_", maand_labels))
    )

    result_list[[r]] <- out
  }

  df <- bind_cols(df, bind_rows(result_list))
  assign(dataset_naam, df, envir = .GlobalEnv)
}

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