如何结合purrr::map与dplyr::mutate处理嵌套与非嵌套列

背景与需求 #

我正在推进一个双数据集结合的计算项目，df中的每个id在event数据集中对应0到3行记录。要求保留df的原始行数，找出每个id对应date之后的第一个event_date，同时要保留嵌套数据用于后续计算，希望通过purrr系列函数实现这个逻辑。

示例数据 #

df <- tibble::tribble(
  ~id,        ~date,
  1L, "2010-01-01", 
  2L, "2010-01-02",
  3L, "2010-01-03",
  4L, "2010-01-04",
  5L, "2010-01-05",
  6L, "2010-01-06",
  7L, "2010-01-07",
  8L, "2010-01-08",
  9L, "2010-01-09",
  10L, "2010-01-10"
) %>% dplyr::mutate(date = as.Date(date))

event <- tibble::tribble(
~id, ~event,  ~event_date,
1L,    "A", "2009-01-01",
1L,    "B", "2009-06-30",
2L,    "A", "2011-01-01",
4L,    "A", "2006-01-01",
4L,    "B", "2008-02-15",
4L,    "B", "2012-12-15",
8L,    "A", "2010-01-08",
9L,    "B", "2010-03-30"
) %>% dplyr::mutate(event_date = as.Date(event_date))

当前尝试与问题 #

为了保留df的行数，我用dplyr::nest_join生成了嵌套数据框：

df_nest <- dplyr::nest_join(df, event)

之后尝试用purrr::map2计算目标日期，但当所有event_date都小于等于date时，min()会因为没有有效输入而报错：

df_nest %>% 
  dplyr::mutate(
    first_event_after = purrr::map2(
      .x = event,
      .y = date,
      ~ if(length(.x$event_date) > 0){
        .x %>% filter(event_date > .y) %>% pull(event_date) %>% min()
      } else {NA}
    )
  ) -> df_nest_dates

我试过dplyr::rowwise()但没能写出对比event[["event_date"]]和date的逻辑。另外我有一个能得到结果的方案，但无法保留嵌套数据用于后续计算：

left_join(event, df) %>% filter(event_date > date) %>% arrange(date) %>% distinct(id, .keep_all = T) %>% left_join(df, .)

解决方案 #

方法1：优化map2逻辑，判断过滤后的数据长度 #

修改原代码，先提取过滤后的日期，判断是否有有效数据，再返回对应结果（用NA_Date_作为日期型空值，比普通NA更规范）：

df_nest %>% 
  dplyr::mutate(
    first_event_after = purrr::map2(
      .x = event,
      .y = date,
      ~ {
        # 筛选当前date之后的event_date
        filtered_dates <- .x %>% dplyr::filter(event_date > .y) %>% dplyr::pull(event_date)
        # 根据筛选结果返回值
        if (length(filtered_dates) > 0) min(filtered_dates) else NA_Date_
      }
    )
  ) -> df_nest_dates

方法2：用slice_min简化逻辑 #

利用dplyr::slice_min直接选出最小的符合条件的日期，再用first()处理空结果（空时自动返回NA），代码更简洁：

df_nest %>% 
  dplyr::mutate(
    first_event_after = purrr::map2(
      .x = event,
      .y = date,
      ~ .x %>% 
        dplyr::filter(event_date > .y) %>% 
        # 选出最小的1个event_date，避免多值
        dplyr::slice_min(event_date, n = 1, with_ties = FALSE) %>% 
        dplyr::pull(event_date) %>% 
        # 空结果时返回NA
        dplyr::first()
    )
  )

方法3：结合rowwise与map #

如果习惯按行处理的思路，可以用rowwise拆分后逐行计算：

df_nest %>% 
  dplyr::rowwise() %>% 
  dplyr::mutate(
    first_event_after = {
      filtered <- event %>% dplyr::filter(event_date > date) %>% dplyr::pull(event_date)
      if (length(filtered) > 0) min(filtered) else NA_Date_
    }
  ) %>% 
  dplyr::ungroup()

以上三种方法都能保留嵌套的event数据框，满足后续计算需求，同时解决了空输入导致的报错问题。

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