Rstats functions for calculating if a specified date is a public holiday in New Zealand

NZHolidays.R 5.1KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160
  1. # Functions to calculate if a date
  2. # is a holiday or weekend.
  3. # Functions are vectorised, so can
  4. # be used with columns of dates.
  5. # Note: Holidays are mondayised if they fall on weekends
  6. # and the Saturday/Sunday parts of Easter are excluded.
  7. # Change the code if this is not the way you want it to work.
  8. # Note: Mondayisation for ANZAC and Waitangi were introduced
  9. # only in 2015 and 2016 respectively. Non-mondayised versions
  10. # of these holidays are trivial to calculate.
  11. # Note: This file includes code to calculate
  12. # Wellington Anniversary weekend, although it is not
  13. # included in the is.NZHoliday function. No other anniversary
  14. # days are included at this time.
  15. library(timeDate) # For Easter calculation
  16. # Determine if a given day is a weekend
  17. is.Weekend <- function(x) {
  18. return(weekdays(x) %in% c("Saturday", "Sunday"))
  19. }
  20. # Determine if a given date is in the
  21. # range easter friday to easter monday inclusive.
  22. # Note that this includes the whole weekend
  23. is.Easter <- function(x) {
  24. year <- as.numeric(format(x, "%Y"))
  25. date.easter <- as.Date(timeDate::Easter(year))
  26. # Make this (-2:2) to include Easter Tuesday
  27. # (not a public holiday, but it is for e.g.
  28. # schoolchildren.)
  29. # Change to c(-2:1) to include weekend
  30. return((x - date.easter) %in% c(-2, 1))
  31. }
  32. # Determine if a given day is Waitangi
  33. # day (observed), i.e. the following
  34. # Monday if on weekend (from 2016)
  35. is.Waitangi <- function(x) {
  36. yearstr <- format(x, "%Y")
  37. year <- as.numeric(yearstr)
  38. date.wait <- as.Date(paste0(yearstr, "-02-06"))
  39. day.wait <- weekdays(date.wait)
  40. date.hol <- ifelse(day.wait == "Saturday",
  41. date.wait + 2,
  42. ifelse(day.wait=="Sunday",
  43. date.wait + 1,
  44. date.wait))
  45. return(ifelse(year >= 2016, x == date.hol, x == date.wait))
  46. }
  47. # Mondayised ANZAC
  48. is.ANZAC <- function(x) {
  49. yearstr <- format(x, "%Y")
  50. year <- as.numeric(yearstr)
  51. date.anzac <- as.Date(paste0(yearstr, "-04-25"))
  52. day.anzac <- weekdays(date.anzac)
  53. date.hol <- ifelse(day.anzac == "Saturday",
  54. date.anzac + 2,
  55. ifelse(day.anzac=="Sunday",
  56. date.anzac + 1,
  57. date.anzac))
  58. return(ifelse(year >= 2015, x == date.hol, x == date.anzac))
  59. }
  60. # Determine if a given day is Labour day
  61. is.Labour <- function(x) {
  62. is.oct <- months(x) == "October"
  63. month.day <- as.numeric(format(x, "%d"))
  64. dow <- weekdays(x)
  65. week <- ((month.day - 1) %/% 7) + 1
  66. return(is.oct & (dow == "Monday") & (week == 4))
  67. }
  68. # Determine if a given day is Queens birthday
  69. is.QB <- function(x) {
  70. is.jun <- months(x) == "June"
  71. month.day <- as.numeric(format(x, "%d"))
  72. dow <- weekdays(x)
  73. week <- ((month.day - 1) %/% 7) + 1
  74. return(is.jun & (dow == "Monday") & (week == 1))
  75. }
  76. # Determine if christmas day (observed)
  77. is.Christmas <- function(x) {
  78. yearstr <- format(x, "%Y")
  79. date.chris <- as.Date(paste0(yearstr, "-12-25"))
  80. day.chris <- weekdays(date.chris)
  81. date.hol <- ifelse(day.chris == "Saturday",
  82. date.chris + 2,
  83. ifelse(day.chris=="Sunday",
  84. date.chris + 1,
  85. date.chris))
  86. return(x == date.hol)
  87. }
  88. # Determine if boxing day (observed)
  89. is.Boxing <- function(x) {
  90. yearstr <- format(x, "%Y")
  91. date.box <- as.Date(paste0(yearstr, "-12-26"))
  92. day.box <- weekdays(date.box)
  93. date.hol <- ifelse(day.box %in% c("Saturday", "Sunday"),
  94. date.box + 2,
  95. ifelse(day.box=="Monday",
  96. date.box + 1,
  97. date.box))
  98. return(x == date.hol)
  99. }
  100. # Determine if new years day (observed)
  101. is.NewYears <- function(x) {
  102. yearstr <- format(x, "%Y")
  103. date.ny <- as.Date(paste0(yearstr, "-01-01"))
  104. day.ny <- weekdays(date.ny)
  105. date.hol <- ifelse(day.ny == "Saturday",
  106. date.ny + 2,
  107. ifelse(day.ny=="Sunday",
  108. date.ny + 1,
  109. date.ny))
  110. return(x == date.hol)
  111. }
  112. # Determine if new years day plus one (observed)
  113. is.NewYearsPlusOne <- function(x) {
  114. yearstr <- format(x, "%Y")
  115. date.nyp1 <- as.Date(paste0(yearstr, "-01-02"))
  116. day.nyp1 <- weekdays(date.nyp1)
  117. date.hol <- ifelse(day.nyp1 %in% c("Saturday", "Sunday"),
  118. date.nyp1 + 2,
  119. ifelse(day.nyp1=="Monday",
  120. date.nyp1 + 1,
  121. date.nyp1))
  122. return(x == date.hol)
  123. }
  124. # Determine if date is wellington
  125. # anniversary, i.e closest
  126. # Monday to the 22nd of Jan.
  127. is.WellingtonAnn <- function(x) {
  128. yearstr <- format(x, "%Y")
  129. date.theory <- as.Date(paste0(yearstr, "-01-22"))
  130. day.x <- weekdays(x)
  131. return(day.x == "Monday" & abs(x - date.theory) < 4)
  132. }
  133. # Determines if day is an NZ
  134. # Public holiday
  135. is.NZHoliday <- function(x) {
  136. is.Easter(x) | is.Waitangi(x) | is.ANZAC(x) |
  137. is.Labour(x) | is.QB(x) | is.Christmas(x) |
  138. is.Boxing(x) | is.NewYears(x) | is.NewYearsPlusOne(x)
  139. }
  140. # NZHoliday, but includes Well Ann.
  141. is.WellHoliday <- function(x) {
  142. is.NZHoliday(x) | is.WellingtonAnn(x)
  143. }