使用 purrr:map 和 dplyr::mutate 以及来自嵌套和非嵌套列的输入

Question

我正在做一个项目，结合两个数据集的输入。我想根据两个数据集的数据进行计算。对于

id

中的每个

df

，有 0-3 行与

id

中对应的

events

。

样本数据：

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)

然后我想找到

event_date

之后的第一个

date

。这就是它变得丑陋的地方。我尝试过使用

dplyr::rowwise()

和

purrr::map2()

。使用

purrr:map2()

，我设法通过以下代码获得了几乎我想要的结果，这也给了我一个错误，因为如果

min()

中的所有日期都小于或等于

event_date

，则

date

没有输入。

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

有什么想法吗？我觉得

purrr::map

函数在这种情况下非常有用，但未能以良好的方式应用它们。我什至考虑使用

purrr:map

是错误的吗？我也尝试过

dplyr::rowwise()

，但无法编写一个将

event[["event_date"]]

与

date

进行比较的公式。

我想到了以下解决方案，它为我提供了所需的结果，但这并没有为我提供其他计算的嵌套数据。此问题的目的是了解如何利用

purr::map/map2/pmap

功能。

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

Answer 1

我不清楚您要在哪里存储此日期信息，因此我在顶级小标题中创建了一个新变量：

library(dplyr)
library(purrr)
library(tidyr)

df_nest |>
  mutate(x = map2(date, event, \(d, e) semi_join(e, tibble(dt = d), join_by(closest(event_date > dt))))) |>
  hoist(x, "event_date") |> 
  select(-x)

semi_join

是一种特定类型的 filtering 连接，在这里很方便，因为它不仅允许过滤，而且还允许使用 @lotus 提到的某些类型的连接不等式。不幸的是，

date

作为日期向量传递，而不是小标题（这是连接所需的，因此需要

tibble

调用）。

我使用

tidyr::hoist

将该列拉入顶级数据框架，但如果您尝试将此值存储在嵌套的

event

tibble-column 中，这个答案看起来会有所不同。

---

输出

      id date       event            event_date
   <int> <date>     <list>           <date>    
 1     1 2010-01-01 <tibble [2 × 2]> NA        
 2     2 2010-01-02 <tibble [1 × 2]> 2011-01-01
 3     3 2010-01-03 <tibble [0 × 2]> NA        
 4     4 2010-01-04 <tibble [3 × 2]> 2012-12-15
 5     5 2010-01-05 <tibble [0 × 2]> NA        
 6     6 2010-01-06 <tibble [0 × 2]> NA        
 7     7 2010-01-07 <tibble [0 × 2]> NA        
 8     8 2010-01-08 <tibble [1 × 2]> NA        
 9     9 2010-01-09 <tibble [1 × 2]> 2010-03-30
10    10 2010-01-10 <tibble [0 × 2]> NA