inst/doc/holideh.R

In holideh: Working with Canadian Dates

## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  message = FALSE,
  collapse = TRUE,
  comment = "#>"
)

new_hooks <- fansi::set_knit_hooks(knitr::knit_hooks)

options(
  crayon.enabled = TRUE,
  rmarkdown.html_vignette.check_title = FALSE
)

## -----------------------------------------------------------------------------
library(magrittr)
library(tibble)
library(dplyr)
library(lubridate)
library(purrr)
library(holideh)

## -----------------------------------------------------------------------------
holidays19 <- get_holidays(2019, federal = TRUE)

holidays19

## -----------------------------------------------------------------------------
holidays <- 2026:2028 %>%
  map(\(year) get_holidays(year, federal = TRUE)) %>%
  list_rbind()

holidays

## -----------------------------------------------------------------------------
holidays_on19 <- get_province("ON", year = 2019)

holidays_on19

## -----------------------------------------------------------------------------
simple_example <- tibble(
  dates = seq(from = ymd("2027-12-20"), to = ymd("2028-01-05"), by = "1 day")
)

simple_example

## -----------------------------------------------------------------------------
holiday_dates <- pull(holidays, date)
obs_dates <- pull(holidays, observed_date)

## -----------------------------------------------------------------------------
simple_example <- simple_example %>%
  mutate(
    # `wday()` is from lubridate
    day_of_week = wday(dates, label = TRUE, abbr = FALSE),
    
    # Check if a date is a weekend
    weekend = is_weekend(dates),
    
    # Check if a holiday falls on a date using the "actual dates"
    true_holiday = is_holiday(dates, holiday_dates),
    
    # Check if a holiday falls on a date using the "observed dates"
    obs_holiday = is_holiday(dates, obs_dates),
    
    # Check if a date is a business day (i.e. not holiday + not weekend)
    bizday = is_bizday(dates, holidays = obs_dates)
  ) %>%
  left_join(
    select(holidays, observed_date, name_en),
    by = c("dates" = "observed_date")
  )

simple_example

## ----echo = FALSE-------------------------------------------------------------
set.seed(25)

## -----------------------------------------------------------------------------
real_example <- tibble(
  end = seq(from = ymd("2027-11-03"), to = ymd("2028-01-27"), by = "2 weeks"),
  points = ceiling(runif(length(end), min = 90, max = 120))
)

real_example

## -----------------------------------------------------------------------------
real_example <- real_example %>%
  mutate(start = end - days(13)) %>%
  relocate(start)

real_example

## -----------------------------------------------------------------------------
real_example <- real_example %>%
  mutate(
    n_bizdays = map2_int(
      start, end,
      \(from, to) count_bizdays(from, to, holidays = obs_dates)
    ),
    productivity = points / n_bizdays
  )

real_example

## -----------------------------------------------------------------------------
tibble(
  dates = seq(from = ymd("2027-12-16"), to = ymd("2027-12-29"), by = "1 day"),
  day_of_week = wday(dates, label = TRUE, abbr = FALSE)
) %>%
  mutate(
    # Check if a date is a weekend
    weekend = is_weekend(dates),
    
    # Check if a holiday falls on a date using the "actual dates"
    true_holiday = is_holiday(dates, holiday_dates),
    
    # Check if a holiday falls on a date using the "observed dates"
    obs_holiday = is_holiday(dates, obs_dates),
    
    # Check if a date is a business day (i.e. not holiday + not weekend)
    bizday = is_bizday(dates, holidays = obs_dates)
  ) %>%
  left_join(
    select(holidays, observed_date, name_en),
    by = c("dates" = "observed_date")
  )