123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160 |
- # Functions to calculate if a date
- # is a holiday or weekend.
- # Functions are vectorised, so can
- # be used with columns of dates.
-
- # Note: Holidays are mondayised if they fall on weekends
- # and the Saturday/Sunday parts of Easter are excluded.
- # Change the code if this is not the way you want it to work.
-
- # Note: Mondayisation for ANZAC and Waitangi were introduced
- # only in 2015 and 2016 respectively. Non-mondayised versions
- # of these holidays are trivial to calculate.
-
- # Note: This file includes code to calculate
- # Wellington Anniversary weekend, although it is not
- # included in the is.NZHoliday function. No other anniversary
- # days are included at this time.
-
- library(timeDate) # For Easter calculation
-
- # Determine if a given day is a weekend
- is.Weekend <- function(x) {
- return(weekdays(x) %in% c("Saturday", "Sunday"))
- }
-
- # Determine if a given date is in the
- # range easter friday to easter monday inclusive.
- # Note that this includes the whole weekend
- is.Easter <- function(x) {
- year <- as.numeric(format(x, "%Y"))
- date.easter <- as.Date(timeDate::Easter(year))
- # Make this (-2:2) to include Easter Tuesday
- # (not a public holiday, but it is for e.g.
- # schoolchildren.)
- # Change to c(-2:1) to include weekend
- return((x - date.easter) %in% c(-2, 1))
- }
-
- # Determine if a given day is Waitangi
- # day (observed), i.e. the following
- # Monday if on weekend (from 2016)
- is.Waitangi <- function(x) {
- yearstr <- format(x, "%Y")
- year <- as.numeric(yearstr)
- date.wait <- as.Date(paste0(yearstr, "-02-06"))
- day.wait <- weekdays(date.wait)
- date.hol <- ifelse(day.wait == "Saturday",
- date.wait + 2,
- ifelse(day.wait=="Sunday",
- date.wait + 1,
- date.wait))
- return(ifelse(year >= 2016, x == date.hol, x == date.wait))
- }
-
- # Mondayised ANZAC
- is.ANZAC <- function(x) {
- yearstr <- format(x, "%Y")
- year <- as.numeric(yearstr)
- date.anzac <- as.Date(paste0(yearstr, "-04-25"))
- day.anzac <- weekdays(date.anzac)
- date.hol <- ifelse(day.anzac == "Saturday",
- date.anzac + 2,
- ifelse(day.anzac=="Sunday",
- date.anzac + 1,
- date.anzac))
- return(ifelse(year >= 2015, x == date.hol, x == date.anzac))
- }
-
- # Determine if a given day is Labour day
- is.Labour <- function(x) {
- is.oct <- months(x) == "October"
- month.day <- as.numeric(format(x, "%d"))
- dow <- weekdays(x)
- week <- ((month.day - 1) %/% 7) + 1
- return(is.oct & (dow == "Monday") & (week == 4))
- }
-
- # Determine if a given day is Queens birthday
- is.QB <- function(x) {
- is.jun <- months(x) == "June"
- month.day <- as.numeric(format(x, "%d"))
- dow <- weekdays(x)
- week <- ((month.day - 1) %/% 7) + 1
- return(is.jun & (dow == "Monday") & (week == 1))
- }
-
- # Determine if christmas day (observed)
- is.Christmas <- function(x) {
- yearstr <- format(x, "%Y")
- date.chris <- as.Date(paste0(yearstr, "-12-25"))
- day.chris <- weekdays(date.chris)
- date.hol <- ifelse(day.chris == "Saturday",
- date.chris + 2,
- ifelse(day.chris=="Sunday",
- date.chris + 1,
- date.chris))
- return(x == date.hol)
- }
-
- # Determine if boxing day (observed)
- is.Boxing <- function(x) {
- yearstr <- format(x, "%Y")
- date.box <- as.Date(paste0(yearstr, "-12-26"))
- day.box <- weekdays(date.box)
- date.hol <- ifelse(day.box %in% c("Saturday", "Sunday"),
- date.box + 2,
- ifelse(day.box=="Monday",
- date.box + 1,
- date.box))
- return(x == date.hol)
- }
-
- # Determine if new years day (observed)
- is.NewYears <- function(x) {
- yearstr <- format(x, "%Y")
- date.ny <- as.Date(paste0(yearstr, "-01-01"))
- day.ny <- weekdays(date.ny)
- date.hol <- ifelse(day.ny == "Saturday",
- date.ny + 2,
- ifelse(day.ny=="Sunday",
- date.ny + 1,
- date.ny))
- return(x == date.hol)
- }
-
- # Determine if new years day plus one (observed)
- is.NewYearsPlusOne <- function(x) {
- yearstr <- format(x, "%Y")
- date.nyp1 <- as.Date(paste0(yearstr, "-01-02"))
- day.nyp1 <- weekdays(date.nyp1)
- date.hol <- ifelse(day.nyp1 %in% c("Saturday", "Sunday"),
- date.nyp1 + 2,
- ifelse(day.nyp1=="Monday",
- date.nyp1 + 1,
- date.nyp1))
- return(x == date.hol)
- }
-
- # Determine if date is wellington
- # anniversary, i.e closest
- # Monday to the 22nd of Jan.
- is.WellingtonAnn <- function(x) {
- yearstr <- format(x, "%Y")
- date.theory <- as.Date(paste0(yearstr, "-01-22"))
- day.x <- weekdays(x)
- return(day.x == "Monday" & abs(x - date.theory) < 4)
- }
-
- # Determines if day is an NZ
- # Public holiday
- is.NZHoliday <- function(x) {
- is.Easter(x) | is.Waitangi(x) | is.ANZAC(x) |
- is.Labour(x) | is.QB(x) | is.Christmas(x) |
- is.Boxing(x) | is.NewYears(x) | is.NewYearsPlusOne(x)
- }
-
- # NZHoliday, but includes Well Ann.
- is.WellHoliday <- function(x) {
- is.NZHoliday(x) | is.WellingtonAnn(x)
- }
|