I have start dates and end dates ('days from index') and want to change the end date if it is <=50 days to the next start date within each group, i.e. 'bridge' the time periods.
Example:
library(tidyverse)
df <- structure(list(effective_time_from_index_start = c(373, 569, 932, 1280, 1410, 1610, 20, 80, NA, 140),
effective_time_from_index_end = c(520, 883, 1233, 1387, 1624, NA, 40, 100, 120, NA),
group = c(1,1,1,2,2,2,3,3,3,3)),
row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))
df
#> # A tibble: 10 × 3
#> effective_time_from_index_start effective_time_from_index_end group
#> <dbl> <dbl> <dbl>
#> 1 373 520 1
#> 2 569 883 1
#> 3 932 1233 1
#> 4 1280 1387 2
#> 5 1410 1624 2
#> 6 1610 NA 2
#> 7 20 40 3
#> 8 80 100 3
#> 9 NA 120 3
#> 10 140 NA 3
Desired output:
# conceptually, I can use a 'chain' of mutate/ifelse statements
desired_df <- df %>%
group_by(group) %>%
mutate(effective_time_from_index_end = ifelse(
is.na(lead(effective_time_from_index_end)) |
effective_time_from_index_end <
lead(effective_time_from_index_start, default = 9999) - 50,
effective_time_from_index_end,
lead(effective_time_from_index_end)
)) %>%
mutate(effective_time_from_index_end = ifelse(
is.na(lead(effective_time_from_index_end)) |
effective_time_from_index_end <
lead(effective_time_from_index_start, default = 9999) - 50,
effective_time_from_index_end,
lead(effective_time_from_index_end)
)) %>%
mutate(effective_time_from_index_end = ifelse(
is.na(lead(effective_time_from_index_end)) |
effective_time_from_index_end <
lead(effective_time_from_index_start, default = 9999) - 50,
effective_time_from_index_end,
lead(effective_time_from_index_end)
))
desired_df
#> # A tibble: 10 × 3
#> # Groups: group [3]
#> effective_time_from_index_start effective_time_from_index_end group
#> <dbl> <dbl> <dbl>
#> 1 373 1233 1
#> 2 569 1233 1
#> 3 932 1233 1
#> 4 1280 1624 2
#> 5 1410 1624 2
#> 6 1610 NA 2
#> 7 20 100 3
#> 8 80 100 3
#> 9 NA 120 3
#> 10 140 NA 3
# This gives me the 'correct' outcome, which I can then
# filter the to get the 'bridged' time-periods
final_desired_df <- desired_df %>%
filter(effective_time_from_index_start == min(effective_time_from_index_start, na.rm = TRUE))
final_desired_df
#> # A tibble: 3 × 3
#> # Groups: group [3]
#> effective_time_from_index_start effective_time_from_index_end group
#> <dbl> <dbl> <dbl>
#> 1 373 1233 1
#> 2 1280 1624 2
#> 3 20 100 3
But I'm sure there is a more robust and less ugly solution (tidyverse preferred, but base-r or data.table would also be very much appreciated).
Failed attempts:
compare_func <- function(df, n = 6) {
for (i in 1:n) {
if (df$effective_time_from_index_end[i] >
df$effective_time_from_index_start[i + 1] - 60) {
max <- df$effective_time_from_index_end[i + 1]
} else {
break
}
}
return(max)
}
df %>%
na.omit() %>%
group_by(group) %>%
mutate(effective_time_from_index_end = compare_func(.))
#> # A tibble: 7 × 3
#> # Groups: group [3]
#> effective_time_from_index_start effective_time_from_index_end group
#> <dbl> <dbl> <dbl>
#> 1 373 100 1
#> 2 569 100 1
#> 3 932 100 1
#> 4 1280 100 2
#> 5 1410 100 2
#> 6 20 100 3
#> 7 80 100 3
# doesn't work "by group" and need to omit NAs prior to mutate (don't want to omit NAs)
# This approach also works if you omit NAs prior to calculation,
# but I want to keep the NAs in the output
df %>%
na.omit() %>%
group_by(group) %>%
mutate(effective_time_from_index_end = reduce(map(1:3, ~ifelse(
!is.na(lead(effective_time_from_index_start, n = .x)) &
!is.na(lead(effective_time_from_index_end, n = .x)) &
lead(effective_time_from_index_start, n = .x) >
effective_time_from_index_end + 50,
lead(effective_time_from_index_end, n = .x),
effective_time_from_index_end
)), .f = max))
#> # A tibble: 7 × 3
#> # Groups: group [3]
#> effective_time_from_index_start effective_time_from_index_end group
#> <dbl> <dbl> <dbl>
#> 1 373 1233 1
#> 2 569 1233 1
#> 3 932 1233 1
#> 4 1280 1624 2
#> 5 1410 1624 2
#> 6 20 100 3
#> 7 80 100 3
Created on 2022-09-21 by the reprex package (v2.0.1)