Created
August 21, 2024 13:52
-
-
Save francisbarton/d8bd17f74a0a51d075b77080c750b6ec to your computer and use it in GitHub Desktop.
Working days in EW calculation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #' Returns a vector of bank holiday dates in England and Wales | |
| #' | |
| #' Currently dates from 2018-2026 are available via gov.uk | |
| #' https://www.gov.uk/bank-holidays | |
| #' | |
| #' @returns A vector of dates | |
| #' @export | |
| ew_holidays <- function() { | |
| "https://www.gov.uk/bank-holidays/england-and-wales.ics" |> | |
| readLines() |> | |
| stringr::str_subset("^DTSTART") |> | |
| stringr::str_extract_all("\\d+$") |> | |
| lubridate::ymd() | |
| } | |
| #' Returns a vector of working days between two dates | |
| #' | |
| #' Working days applies for England and Wales only. Dates returned are all | |
| #' weekdays (Mon-Fri) between x and y (inclusive), but excluding any official | |
| #' public holidays (bank holidays) as listed at https://www.gov.uk/bank-holidays | |
| #' | |
| #' @param x,y character, parseable as a date, ideally in ymd format like | |
| #' "2024-01-31" | |
| #' @param bh A vector of bank holiday dates. Pulled in from gov.uk by default, | |
| #' but can be supplied manually to save re-scraping each time. | |
| #' | |
| #' @returns A vector of dates | |
| #' @export | |
| working_days <- function(x, y, bh = ew_holidays()) { | |
| x <- lubridate::as_date(x) | |
| y <- lubridate::as_date(y) | |
| assert_that(y > x, msg = "y must be after x") | |
| seq.Date(x, y, "1 day") |> | |
| purrr::keep(\(x) vec_in(lubridate::wday(x, week_start = 1), 1:5)) |> | |
| purrr::discard(\(x) vec_in(x, bh)) | |
| } | |
| #' Returns a date a certain number (n) of working days after the supplied date | |
| #' | |
| #' Working days here applies for England and Wales only: all weekdays (Mon-Fri) | |
| #' excluding any bank holidays as listed at https://www.gov.uk/bank-holidays. | |
| #' This function works for dates from 1 January 2018 to 31 December 2026 only. | |
| #' | |
| #' If x is not a working day, say Monday 1 January, then the date returned when | |
| #' n = 1 will be 2 January (the first working day after 1 January). | |
| #' | |
| #' @param x character, parseable as a date, ideally in ymd format like | |
| #' "2024-01-31"; or any existing date/datetime object. Can be a vector of | |
| #' multiple dates. | |
| #' @param n numeric (integer) number of working days to add to x. Must be a | |
| #' single number, not a vector of multiple numbers. Passing n = 1 returns the | |
| #' first working day after x. | |
| #' | |
| #' | |
| #' @seealso [working_days()] | |
| #' @rdname working_days | |
| #' @returns A vector of dates of the same length as x | |
| #' @export | |
| add_n_working_days <- function(x, n) { | |
| assert_that(length(n) == 1L, n >= 1L) | |
| n <- round(n) | |
| x <- lubridate::as_date(x) | |
| assert_that(all(lubridate::is.Date(x))) | |
| # get a kind of "upper limit" date, to create a range to work from below | |
| n2 <- max(1L, (ceiling(n/365) * 10L) + (ceiling(n/5) * 7L)) # on the safe side | |
| y <- max(x) + lubridate::days(n2) | |
| if (min(x) < as.Date("2018-01-01") | y > as.Date("2026-12-31")) { | |
| paste0( | |
| "This function only works correctly for dates between 2018-2026. Either ", | |
| "your supplied date(s) or the calculated end date(s) are outside this." | |
| ) |> | |
| cli::cli_alert_warning() | |
| } | |
| wd <- working_days(min(x), y) | |
| # Check we won't overflow the vector of working dates we've created | |
| # (Unlikely to happen - we have set n2 as quite a comfortable upper margin) | |
| assert_that((min(which(wd > max(x))) + (n - 1)) <= length(wd)) | |
| purrr::map_vec(x, \(x, w = wd) w[[min(which(w > x)) + (n - 1)]]) | |
| } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment