Created
October 24, 2018 04:16
-
-
Save PetraOleum/cd1dfd1c71c8a4c4a4cc177f5264f703 to your computer and use it in GitHub Desktop.
Rstats functions for calculating if a specified date is a public holiday in New Zealand
This file contains 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
# 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) | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment