Split durations into annual parts

Question

Issue: I have a dataframe that consists of durations (columns: begin and end) across cases (column: case). Some durations run across two years. I need to split those cases into annual durations: One part that runs until the end of the year and a remaining duration that begins in the next year.

Current approach: I managed to compute those durations (see current approach below) but i am unable to split the respective rows into multiple ones, while leaving the yearly cases unaffected.

Below you find a reproducible example:

# Packages
library(tidyverse)
library(lubridate)

# Reproducible example
df <- tibble(
  case = c(1, 1, 2, 3),
  begin = ymd("2019-12-20", "2019-08-05", "2012-01-01", "2014-10-10"),
  end = ymd("2020-01-15", "2019-08-20", "2012-01-12", "2015-01-15"),
  reason = c("X", "Y", "X", "Y")) 

head(df)
#> # A tibble: 4 x 4
#>    case begin      end        reason
#>               
#> 1     1 2019-12-20 2020-01-15 X     
#> 2     1 2019-08-05 2019-08-20 Y     
#> 3     2 2012-01-01 2012-01-12 X     
#> 4     3 2014-10-10 2015-01-15 Y

# Goal (split durations and make them "longer")
goal <- tibble(
  case = c(1, 1, 1, 2, 3, 3),
  begin = ymd("2019-12-20", "2020-01-01", "2019-08-05", "2012-01-01", "2014-10-10", "2015-01-01"),
  end = ymd("2019-12-31", "2020-01-15", "2019-08-20", "2012-01-12", "2014-12-31", "2015-01-15"),
  reason = c("X", "X", "Y", "X", "Y", "Y")) 

head(goal)
#> # A tibble: 6 x 4
#>    case begin      end        reason
#>               
#> 1     1 2019-12-20 2019-12-31 X     
#> 2     1 2020-01-01 2020-01-15 X     
#> 3     1 2019-08-05 2019-08-20 Y     
#> 4     2 2012-01-01 2012-01-12 X     
#> 5     3 2014-10-10 2014-12-31 Y     
#> 6     3 2015-01-01 2015-01-15 Y

# Current approach
df %>%
  mutate(end_year = if_else(year(begin) != year(end), 
                            ceiling_date(ymd(begin), "year") - days(1), end),
         begin_year = if_else(year(begin) != year(end), 
                              ceiling_date(ymd(end), "year"), begin))
#> # A tibble: 4 x 6
#>    case begin      end        reason end_year   begin_year
#>                         
#> 1     1 2019-12-20 2020-01-15 X      2019-12-31 2021-01-01
#> 2     1 2019-08-05 2019-08-20 Y      2019-08-20 2019-08-05
#> 3     2 2012-01-01 2012-01-12 X      2012-01-12 2012-01-01
#> 4     3 2014-10-10 2015-01-15 Y      2014-12-31 2016-01-01

It would be grateful appreciated if you could pinpoint me to a solution. Thanks in advance.

Edit based on the answer by Allan Cameron:

# Final solution
library(tidyverse)
library(lubridate)

# Reproducible example
df <- tibble(
  case = c(1, 1, 2, 3),
  begin = ymd("2019-12-20", "2019-08-05", "2012-01-01", "2014-10-10"),
  end = ymd("2020-01-15", "2019-08-20", "2012-01-12", "2015-01-15"),
  reason = c("X", "Y", "X", "Y")) 

# Find durations that run across a year
df2 <- df %>%
  filter(year(end) != year(begin)) %>%
  mutate(begin = ceiling_date(ymd(begin), "year"), begin)

# 
df <- df %>%
  mutate(end = if_else(year(end) != year(begin), 
                       ceiling_date(ymd(begin), "year") - days(1), end))

# Merge
df <- df %>%
  bind_rows(df2) %>%
  arrange(case, reason)

head(df)
#> # A tibble: 6 x 4
#>    case begin      end        reason
#>               
#> 1     1 2019-12-20 2019-12-31 X     
#> 2     1 2020-01-01 2020-01-15 X     
#> 3     1 2019-08-05 2019-08-20 Y     
#> 4     2 2012-01-01 2012-01-12 X     
#> 5     3 2014-10-10 2014-12-31 Y     
#> 6     3 2015-01-01 2015-01-15 Y

user_12500315 · Answer

You can't use mutate to make your data longer.

It's probably easiest to show how this can be done in base R syntax by duplicating the entries which bridge a year, then using the lubridate functions to control the month and day as required before joining the duplicates back to the original data frame.

bridgers                <- which(year(df$end) != year(df$begin))
df2                     <- df[bridgers,]

year(df$end[bridgers])  <- year(df$begin[bridgers])
month(df$end[bridgers]) <- 12
mday(df$end[bridgers])  <- 31

year(df2$begin)         <- year(df2$end)
month(df2$begin)        <- 1
mday(df2$begin)         <- 1

df <- rbind(df, df2)
df[order(df$case), ]
#> # A tibble: 6 x 4
#>    case begin      end        reason
#>               
#> 1     1 2019-12-20 2019-12-31 X     
#> 2     1 2019-08-05 2019-08-20 Y     
#> 3     1 2020-01-01 2020-01-15 X     
#> 4     2 2012-01-01 2012-01-12 X     
#> 5     3 2014-10-10 2014-12-31 Y     
#> 6     3 2015-01-01 2015-01-15 Y

^{Created on 2020-03-24 by the reprex package (v0.3.0)}

Split durations into annual parts

1 Answers