How to split out (break down) the dates in R?

user_13884754 0
Viewed 159

I am working a study on sick leave using register data. From the register, I got only starting dates and end dates of sick leaves for each individual. But the dates are not broken down year by year. For instance , for person A, there are only data for start date (1-may-2016) and end date (14-feb-2018).

So, I would like to know how I can split out the dates year by year in R (ie. 01/05/16 to 14/02/18 will be divided into 01/5/16-31/12/16, 01/01/2017-31/12/17, 01/01/18-14/02/18) in order to calculate total number of sick leaves for each year.

The example data created for the question is as follow;

sick_leave <- tribble(
      ~id,        ~from,          ~to, 
        1, "01/01/2018", "03/10/2020",
        2, "01/01/2016", "01/01/2021", 
        3, "02/01/2018", "02/06/2018",
        3, "02/07/2018", "31/12/2018",
        4, "02/10/2018", "02/02/2019",
        4, "31/12/2019", "01/01/2021",
        5, "02/10/2017", "20/05/2018",
        6, "02/03/2021", "31/12/2021",
        7, "01/01/2016", "05/06/2016"
    ) %>% mutate(from = dmy(from),to = dmy(to))

The desired output is:

id  year  from        to          wanted
 1  2018  2018-01-01  2018-12-31  365
 1  2019  2019-01-01  2019-12-31  365
 1  2020  2020-01-01  2020-10-03  277
 2  2016  2016-01-01  2016-12-31  366
 2  2017  2017-01-01  2017-12-31  365
 2  2018  2018-01-01  2018-12-31  365
 2  2019  2019-01-01  2019-12-31  365
 2  2020  2020-01-01  2020-12-31  366
 2  2021  2021-01-01  2021-01-01    1
 3  2018  2018-01-02  2018-06-02  152
 3  2018  2018-07-02  2018-12-31  183
 4  2018  2018-10-02  2018-12-31   91
 4  2019  2019-01-01  2019-02-02   33
 4  2019  2019-12-31  2019-12-31    1
 4  2020  2020-01-01  2020-12-31  366
 4  2021  2021-01-01  2021-01-01    1
 5  2017  2017-10-02  2017-12-31   91
 5  2018  2018-01-01  2018-05-20  140
 6  2021  2021-03-02  2021-12-31  305
 7  2016  2016-01-01  2016-06-05  157
r
2 Answers

With this solution, you can split the dates by creating new rows as per your request.

Note that the function split_by_year is performed row by row.

In the code I'll leave you some comments.

# necessary libraries
library(dplyr)
library(lubridate)

split_by_year <- function(from, to){
    
    year_from <- year(from)
    year_to   <- year(to)
    
    # get sequence of years
    years <- seq(year_from, year_to)
    
    # create start and end date for each year
    starts <- make_date(years)  
    ends   <- make_date(years, 12, 31)
    
    # set starts and ends together, replace limits with from and end
    dates <- sort(c(starts, ends))
    dates[c(1, length(dates))] <- c(from, to)
    
    # recreate dataframe with columns from and to
    m <- matrix(dates, ncol = 2, byrow = TRUE)
    colnames(m) <- c("from", "to")
    mutate_all(as_tibble(m), as_date)
    
}

sick_leave %>%
    rowwise() %>% # next line will be performed row by row
    summarise(id = id, split_by_year(from, to)) %>% 
    mutate(sick_days = as.numeric(to - from + 1))

Output:

# A tibble: 20 x 4
      id from       to         sick_days
   <dbl> <date>     <date>         <dbl>
 1     1 2018-01-01 2018-12-31       365
 2     1 2019-01-01 2019-12-31       365
 3     1 2020-01-01 2020-10-03       277
 4     2 2016-01-01 2016-12-31       366
 5     2 2017-01-01 2017-12-31       365
 6     2 2018-01-01 2018-12-31       365
 7     2 2019-01-01 2019-12-31       365
 8     2 2020-01-01 2020-12-31       366
 9     2 2021-01-01 2021-01-01         1
10     3 2018-01-02 2018-06-02       152
11     3 2018-07-02 2018-12-31       183
12     4 2018-10-02 2018-12-31        91
13     4 2019-01-01 2019-02-02        33
14     4 2019-12-31 2019-12-31         1
15     4 2020-01-01 2020-12-31       366
16     4 2021-01-01 2021-01-01         1
17     5 2017-10-02 2017-12-31        91
18     5 2018-01-01 2018-05-20       140
19     6 2021-03-02 2021-12-31       305
20     7 2016-01-01 2016-06-05       157
user_99182650

Your question sounds like a XY-problem.
Therefor, I skipped the creating of intervals by year, and went straight to your desired answer: calculation of sickdays per id per year..

updated for desired output.. see code added at bottom

sample data

#create sample data
library( data.table)
library( lubridate )
sick_leave <- data.table::fread(' 
 id, from, to
  1, "1/1/2018", "3/10/2020"
  2, "1/1/2016", "1/1/2021"
  3, "2/1/2018", "2/6/2018"
  3, "2/7/2018", "31/12/2018"
  4, "2/10/2018", "2/2/2019"
  4, "31/12/2019", "1/1/2021"
  5, "2/10/2017", "20/5/2018"
  6, "2/3/2021", "31/12/2021"
  7, "1/1/2016", "5/6/2016"')
#set dates as real dates
cols = c("from", "to")
sick_leave[, (cols) := lapply( .SD, as.Date, format = "%d/%m/%Y"), .SDcols = cols ]

code

#if your data is in data.frame / tibble format, use 
data.table::setDT( sick_leave ) 
#to make it a data.table

#create table from min-date to max_date
DT <- data.table( from = seq( min( sick_leave$from, na.rm = TRUE ),
                                    max( sick_leave$to, na.rm = TRUE ),
                                    by = "1 days") )
DT[, to := from + lubridate::days(1) ]

#set keys
setkey( sick_leave, from, to )
setkey( DT, from, to )
#perform overlap join
ans <- foverlaps( sick_leave, DT )
#summarise
ans <- ans[, .(days_sick = .N), by = .(id, year = lubridate::year(from) )]
#cast to wide
dcast( ans, id ~ year, value.var = "days_sick", fill = 0 )

output

#    id 2016 2017 2018 2019 2020 2021
# 1:  1    0    1  365  365  277    0
# 2:  2  366  365  365  365  366    1
# 3:  3    0    0  337    0    0    0
# 4:  4    0    0   92   35  366    1
# 5:  5    0   92  140    0    0    0
# 6:  6    0    0    0    0    0  306
# 7:  7  157    0    0    0    0    0

update matching desired output

code

#if your data is in data.frame / tibble format, use 
data.table::setDT( sick_leave ) 
#to make it a data.table

#make data-table with years
DT <- data.table( from = seq( as.Date("2000-01-01"), length.out = 30, by = "1 year"),
                  to   = seq( as.Date("2000-12-31"), length.out = 30, by = "1 year") )
#set keys
setkey( sick_leave, from, to ); setkey( DT, from, to )
#perform overlap join
ans <- foverlaps( sick_leave, DT )
#choose keep the right columns (start/end)
ans[ from < i.from, from := i.from ]
ans[ to > i.to, to := i.to ]
#cleaning
ans[, `:=`(i.from = NULL, i.to = NULL)][]
#order
setorder( ans, id, from )
#calculate duration
ans[, `:=`( year   = lubridate::year( from ),
            wanted = to - from + 1) ]

output

#           from         to id year   wanted
#  1: 2018-01-01 2018-12-31  1 2018 365 days
#  2: 2019-01-01 2019-12-31  1 2019 365 days
#  3: 2020-01-01 2020-10-03  1 2020 277 days
#  4: 2016-01-01 2016-12-31  2 2016 366 days
#  5: 2017-01-01 2017-12-31  2 2017 365 days
#  6: 2018-01-01 2018-12-31  2 2018 365 days
#  7: 2019-01-01 2019-12-31  2 2019 365 days
#  8: 2020-01-01 2020-12-31  2 2020 366 days
#  9: 2021-01-01 2021-01-01  2 2021   1 days
# 10: 2018-01-02 2018-06-02  3 2018 152 days
# 11: 2018-07-02 2018-12-31  3 2018 183 days
# 12: 2018-10-02 2018-12-31  4 2018  91 days
# 13: 2019-01-01 2019-02-02  4 2019  33 days
# 14: 2019-12-31 2019-12-31  4 2019   1 days
# 15: 2020-01-01 2020-12-31  4 2020 366 days
# 16: 2021-01-01 2021-01-01  4 2021   1 days
# 17: 2017-10-02 2017-12-31  5 2017  91 days
# 18: 2018-01-01 2018-05-20  5 2018 140 days
# 19: 2021-03-02 2021-12-31  6 2021 305 days
# 20: 2016-01-01 2016-06-05  7 2016 157 days
user_63562780
Related