-
Notifications
You must be signed in to change notification settings - Fork 4
/
recur-on-day-of-week.R
159 lines (144 loc) · 4.53 KB
/
recur-on-day-of-week.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
#' Recur on a day of the week
#'
#' @description
#'
#' - `recur_on_day_of_week()` recurs on a specific day of the week.
#'
#' - `recur_on_weekends()` and `recur_on_weekdays()` are helpers for
#' recurring on weekends and weekdays.
#'
#' @details
#' Multiple week day values are allowed, and `nth` will be applied to
#' all of them. If you want to apply different `nth` values to different
#' days of the week, call `recur_on_day_of_week()` twice with different `day`
#' values.
#'
#' It is particularly important to pay attention to the `since` date when using
#' weekly rules. The day of the week to use comes from the `since` date, which,
#' by default, is a Monday (`1900-01-01`). See [almanac_since()] for more
#' information.
#'
#' @inheritParams rlang::args_dots_empty
#'
#' @param x `[rrule]`
#'
#' A recurrence rule.
#'
#' @param day `[integer / character]`
#'
#' Days of the week to recur on. Integer values must be from `1` to `7`, with
#' `1 = Monday` and `7 = Sunday`. This is also allowed to be a full weekday
#' string like `"Tuesday"`, or an abbreviation like `"Tues"`.
#'
#' @param nth `[integer / NULL]`
#'
#' Limit to the n-th occurrence of the `day` in the base frequency. For
#' example, in a monthly frequency, using `nth = -1` would limit to the
#' last `day` in the month. The default of `NULL` chooses all occurrences.
#'
#' @return
#' An updated rrule.
#'
#' @examples
#' # Using default `since` (1900-01-01, a Monday)
#' on_weekly_mondays <- weekly()
#'
#' start <- "1999-01-01" # <- a Friday
#' end <- "1999-03-01"
#'
#' # This finds the first Monday, and then continues from there
#' alma_search(start, end, on_weekly_mondays)
#'
#' # We start counting from a Friday here
#' on_weekly_fridays <- weekly(since = start)
#' alma_search(start, end, on_weekly_fridays)
#'
#' # Alternatively, we could use `recur_on_day_of_week()` and force a recurrence
#' # rule on Friday
#' on_forced_friday <- on_weekly_mondays %>% recur_on_day_of_week("Friday")
#' alma_search(start, end, on_forced_friday)
#'
#' # At monthly frequencies, you can use n-th values to look for particular
#' # week day events
#' on_first_friday_in_month <- monthly() %>% recur_on_day_of_week("Fri", nth = 1)
#' alma_search(start, end, on_first_friday_in_month)
#'
#' # Negative values let you look from the back
#' on_last_friday_in_month <- monthly() %>% recur_on_day_of_week("Fri", nth = -1)
#' alma_search(start, end, on_last_friday_in_month)
#'
#' # At yearly frequencies, this looks for the first sunday of the year
#' on_first_sunday_in_year <- yearly() %>% recur_on_day_of_week("Sunday", nth = 1)
#' alma_search(start, end, on_first_sunday_in_year)
#'
#' # Last week day of the month
#' last_weekday_of_month <- monthly() %>%
#' # Last occurrence of each weekday in the month
#' recur_on_day_of_week(c("Mon", "Tue", "Wed", "Thu", "Fri"), nth = -1) %>%
#' # Now choose the last one of those in each month
#' recur_on_position(-1)
#'
#' alma_search(start, end, last_weekday_of_month)
#'
#' @export
recur_on_day_of_week <- function(x, day, ..., nth = NULL) {
check_dots_empty0(...)
check_rrule(x)
old <- get_rule(x, "day_of_week")
if (is_null(old)) {
old <- new_list(n = 7L)
}
day <- day_of_week_normalize(day)
day <- vec_cast(day, to = integer())
check_no_missing(day)
if (any(day < 1L | day > 7L)) {
abort("`day` must be in [1, 7].")
}
# Early exit for all weekdays
if (is_null(nth)) {
for (elt in day) {
old[[elt]] <- "all"
}
x <- tweak_rrule(x, day_of_week = old)
return(x)
}
nth <- vec_cast(nth, to = integer())
check_no_missing(nth)
is_yearly <- x$rules$frequency == "yearly"
abs_nth <- abs(nth)
if (is_yearly) {
if (any(abs_nth > 53 | abs_nth < 1)) {
abort("`nth` can only take values in [-53, -1] and [1, 53] when the frequency is yearly.")
}
} else {
if (any(abs_nth > 5 | abs_nth < 1)) {
abort("`nth` can only take values in [-5, -1] and [1, 5].")
}
}
for (elt in day) {
old_nth <- old[[elt]]
# The union of "all" and any other nth is "all"
if (identical(old_nth, "all")) {
return(x)
}
if (is_null(old_nth)) {
new_nth <- nth
} else {
new_nth <- vec_set_union(old_nth, nth)
}
new_nth <- vec_unique(new_nth)
new_nth <- vec_sort(new_nth)
old[[elt]] <- new_nth
}
tweak_rrule(x, day_of_week = old)
}
#' @rdname recur_on_day_of_week
#' @export
recur_on_weekdays <- function(x) {
recur_on_day_of_week(x, day = 1:5)
}
#' @rdname recur_on_day_of_week
#' @export
recur_on_weekends <- function(x) {
recur_on_day_of_week(x, day = 6:7)
}