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