clock-almanac-shifting.R

library(clock)
library(almanac)
library(tidyr)

# All possible Monday/Friday pairs in 2019
# (note some will be invalid, which will need to be removed)
grid <- expand_grid(
  year = 2019, 
  month = 1:12, 
  day = c(clock_weekdays$monday, clock_weekdays$friday), 
  index = 1:5
)

x <- year_month_weekday(grid$year, grid$month, grid$day, grid$index)

head(x, n = 20)
#> <year_month_weekday<day>[20]>
#>  [1] "2019-01-Mon[1]" "2019-01-Mon[2]" "2019-01-Mon[3]" "2019-01-Mon[4]"
#>  [5] "2019-01-Mon[5]" "2019-01-Fri[1]" "2019-01-Fri[2]" "2019-01-Fri[3]"
#>  [9] "2019-01-Fri[4]" "2019-01-Fri[5]" "2019-02-Mon[1]" "2019-02-Mon[2]"
#> [13] "2019-02-Mon[3]" "2019-02-Mon[4]" "2019-02-Mon[5]" "2019-02-Fri[1]"
#> [17] "2019-02-Fri[2]" "2019-02-Fri[3]" "2019-02-Fri[4]" "2019-02-Fri[5]"

# drop all invalid dates that got created
x <- x[!invalid_detect(x)]

x <- as.Date(x)
x <- sort(x)

head(x)
#> [1] "2019-01-04" "2019-01-07" "2019-01-11" "2019-01-14" "2019-01-18"
#> [6] "2019-01-21"

# Confirm that they are monday/friday pairs
head(as_weekday(x))
#> <weekday[6]>
#> [1] Fri Mon Fri Mon Fri Mon

# Last Monday in May
on_memorial_day <- yearly() %>%
  recur_on_ymonth("May") %>%
  recur_on_wday("Monday", nth = -1)

# If it was a Memorial day, adjust to next Tuesday
x_adj <- adj_following(x, on_memorial_day)

# Prove that it worked:
where_memorial_day <- which(x != x_adj)

x[where_memorial_day]
#> [1] "2019-05-27"
x_adj[where_memorial_day]
#> [1] "2019-05-28"

as_weekday(x[where_memorial_day])
#> <weekday[1]>
#> [1] Mon
as_weekday(x_adj[where_memorial_day])
#> <weekday[1]>
#> [1] Tue