full_join but with condition on matching - r

Question

I am going to try to make this as simple as possible, I would like a dplyr solution if possible:
Let's say I have a DataFrame of 2 columns called f1. The 2 columns are the reference number of an event and the date_begin is the begin date of the event:
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
I also have another DataFrame called f2 with 2 columns. The 2 columns are the reference number of an event and the date_end is the ending date of the event:
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
I want to use a full_join by reference. That being said:
If there is an end date before there is a begin date I want an NA in stead of the begin date
The end date has to be > than the begin date
If there are 2 end dates for the same reference that are bigger than a begin date take the smallest end date
If there is a begin date with no end date the end date should have an NA
So in this reproducible example I should have an f3 that looks something like the following :
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

As Chuck P mentions, the conditions make this a bit complicated. Rather than use full_join, I've first combined f1 and f2 and then transformed to "long" format. We can then group by reference and sort by date to set up to use case_when to apply the conditions stated in the post or other conditions as needed. The result is then transformed back to "wide" format to present as shown in the post. The code is
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)
The result is
> 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
where the results are sorted by date.

Answer 2

This is more complex than it first appears because of the conditional logic. I broke it down into three steps that occur after we do the initial full_join to make 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
Step 1 set aside the rows where we don't have to do anything because either the begin data or the end date is NA
nothing_to_do <-
f3 %>% filter(is.na(date_begin) | is.na(date_end))
Step 2 identify rows where we have a begin date after an end date like "01100144692499" for these we actually have to add a row and then adjust the rows.
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
))
Step 3 identify rows with multiple beginnings same ending where we have to select the one with the shortest time space like "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)
Glue them all to together
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>
Your data...
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")