full_join 但有条件匹配

Question

我会尽量让这件事变得简单，如果可能的话，我想要一个dplyr 解决方案：

假设我有一个 DataFrame 的 2 个 columns 称为 f1。两列是事件的参考编号，date_begin 是事件的开始日期：

f1
       reference date_begin
1 01100144609598 2020-08-15
2 01100144692499 2020-08-12
3 01100144609598 2020-08-09
4 01100434045112 2020-08-26
5 01100434067379 2020-08-24
6 01100723546188 2020-08-16

我还有另一个 DataFrame 称为 f2 和 2 columns。两列是事件的参考编号，date_end 是事件的结束日期：

      reference  date_end
1 01100144609598 2020-09-06
2 01100144692499 2020-08-10
3 01100434121179 2020-08-25
4 01100578756185 2020-08-17
5 01100578757962 2020-08-31
6 01100578846401 2020-08-16

我想通过引用使用full_join。话虽这么说：

1. 如果在开始日期之前有结束日期，我想要一个 NA 而不是开始日期
2. 结束日期必须大于开始日期
3. 如果同一参考有 2 个结束日期大于开始日期，则取最小的结束日期
4. 如果有一个没有结束日期的开始日期，则结束日期应该有一个 NA

因此，在这个可重现的示例中，我应该有一个 f3，​​如下所示：

           reference date_begin date_end
    1 01100144609598 2020-08-15 2020-09-06
    2 01100144692499      NA    2020-08-10
    3 01100144692499 2020-08-12      NA
    4 01100434121179      NA    2020-08-25
    5 01100578756185      NA    2020-08-17
    6 01100578757962      NA    2020-08-31
    7 01100578846401      NA    2020-08-16
    8 01100144609598 2020-08-09      NA
    9 01100434045112 2020-08-26      NA
   10 01100434067379 2020-08-24      NA
   11 01100723546188 2020-08-16      NA

Answer 1

正如 Chuck P 所提到的，条件使这有点复杂。我没有使用full_join，而是首先组合了f1 和f2，然后转换为“长”格式。然后，我们可以按reference 分组并按date 排序以设置使用case_when 来应用帖子中所述的条件或其他需要的条件。然后将结果转换回“宽”格式以呈现，如帖子所示。代码是

  library(tidyverse)
#
#  combine f1 and f2 and pivot to long format
#
   all <- bind_rows(f1,f2) %>%
         pivot_longer(cols = c(date_begin, date_end),
                      names_to = "type", values_to = "date",
                      values_drop_na = TRUE)
#
#  group by reference, sort by date, and then use 
#  case_when function to pair begin and end dates
#
   all <- all %>% group_by(reference) %>% 
                 arrange(date) %>% 
                  mutate(index = 1:n(),
                         index = case_when(
                                 type == "date_end" & lag(type, n = 1) == "date_begin" ~  lag(index),
                                 TRUE ~ index)) 
#
#  pivot back to wide format to format results as shown in post
#
   result <- all %>% pivot_wider(names_from =type, values_from = date) %>% mutate(index = NULL)

结果是

> result
# A tibble: 11 x 3
# Groups:   reference [9]
   reference      date_begin date_end  
    <chr>          <date>     <date>    
1 01100144609598 2020-08-09 NA        
2 01100144692499 NA         2020-08-10
3 01100144692499 2020-08-12 NA        
4 01100144609598 2020-08-15 2020-09-06
5 01100723546188 2020-08-16 NA        
6 01100578846401 NA         2020-08-16
7 01100578756185 NA         2020-08-17
8 01100434067379 2020-08-24 NA        
9 01100434121179 NA         2020-08-25
10 01100434045112 2020-08-26 NA        
11 01100578757962 NA         2020-08-31

结果按日期排序。

Answer 2

由于条件逻辑，这比最初看起来更复杂。我将其分解为三个步骤，在我们执行初始 full_join 以生成 f3 之后发生

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

f3 <- full_join(f1, f2)
#> Joining, by = "reference"

f3
#>         reference date_begin   date_end
#> 1  01100144609598 2020-08-15 2020-09-06
#> 2  01100144692499 2020-08-12 2020-08-10
#> 3  01100144609598 2020-08-09 2020-09-06
#> 4  01100434045112 2020-08-26       <NA>
#> 5  01100434067379 2020-08-24       <NA>
#> 6  01100723546188 2020-08-16       <NA>
#> 7  01100434121179       <NA> 2020-08-25
#> 8  01100578756185       <NA> 2020-08-17
#> 9  01100578757962       <NA> 2020-08-31
#> 10 01100578846401       <NA> 2020-08-16

第 1 步将我们不必做任何事情的行放在一边，因为开始数据或结束日期都是 NA

nothing_to_do <-
   f3 %>% filter(is.na(date_begin) | is.na(date_end))

第 2 步确定开始日期在结束日期之后的行，例如“01100144692499”，对于这些行，我们实际上必须添加一行，然后调整行。

end_before_beginning <-
   f3 %>% filter(date_begin > date_end) %>%
   group_by(reference) %>%
   do (
      add_row(.,
              reference = .$reference,
              date_begin = .$date_begin,
              .after = 1)
   ) %>%
   ungroup() %>%
   mutate(date_begin =
             case_when(
                !is.na(date_end) ~ as.Date(NA_character_),
                TRUE ~ date_begin
             ))

第 3 步识别具有多个开头相同结尾的行，我们必须选择具有最短时间空间的行，例如“01100144609598”

multiple_beginnings <-
   f3 %>%
   group_by(reference, date_end) %>%
   mutate(instances = n(),
          date_diff = date_end - date_begin) %>%
   filter(instances > 1) %>%
   mutate(date_end =
             case_when(
                date_diff != min(date_diff) ~ as.Date(NA_character_),
                TRUE ~ date_end
             )) %>%
   select(-instances, -date_diff)

把它们粘在一起

final_answer <-
   list(nothing_to_do, end_before_beginning, multiple_beginnings) %>%
   reduce(full_join)
#> Joining, by = c("reference", "date_begin", "date_end")
#> Joining, by = c("reference", "date_begin", "date_end")

final_answer
#>         reference date_begin   date_end
#> 1  01100434045112 2020-08-26       <NA>
#> 2  01100434067379 2020-08-24       <NA>
#> 3  01100723546188 2020-08-16       <NA>
#> 4  01100434121179       <NA> 2020-08-25
#> 5  01100578756185       <NA> 2020-08-17
#> 6  01100578757962       <NA> 2020-08-31
#> 7  01100578846401       <NA> 2020-08-16
#> 8  01100144692499       <NA> 2020-08-10
#> 9  01100144692499 2020-08-12       <NA>
#> 10 01100144609598 2020-08-15 2020-09-06
#> 11 01100144609598 2020-08-09       <NA>

您的数据...

f1 <- structure(list(reference = c("01100144609598", "01100144692499",
                                   "01100144609598", "01100434045112", "01100434067379", "01100723546188"), 
                     date_begin = structure(c(18489, 18486, 18483, 18500, 18498,
                            18490), class = "Date")), row.names = c(NA, -6L), class = "data.frame")


f2 <- structure(list(reference = c("01100144609598", "01100144692499", 
                                   "01100434121179", "01100578756185", "01100578757962", "01100578846401"), 
                     date_end = structure(c(18511, 18484, 18499, 18491, 18505, 
                          18490), class = "Date")), row.names = c(NA, -6L), class = "data.frame")