Add roffset() and deprecate recur_on_easter(offset = ) (#94)

* Implement `roffset()`

* Deprecate `offset` argument of `recur_on_easter()`

* NEWS bullets

NAMESPACE

@@ -3,12 +3,14 @@
 S3method(print,almanac_radjusted)
 S3method(print,almanac_rcustom)
 S3method(print,almanac_rintersect)
+S3method(print,almanac_roffset)
 S3method(print,almanac_rrule)
 S3method(print,almanac_rsetdiff)
 S3method(print,almanac_runion)
 S3method(rschedule_events,almanac_radjusted)
 S3method(rschedule_events,almanac_rcustom)
 S3method(rschedule_events,almanac_rintersect)
+S3method(rschedule_events,almanac_roffset)
 S3method(rschedule_events,almanac_rrule)
 S3method(rschedule_events,almanac_rschedule)
 S3method(rschedule_events,almanac_rsetdiff)
@@ -68,6 +70,7 @@ export(recur_on_ymonth)
 export(recur_on_yweek)
 export(recur_with_week_start)
 export(rintersect)
+export(roffset)
 export(rschedule_events)
 export(rsetdiff)
 export(runion)

NEWS.md

@@ -1,5 +1,11 @@
 # almanac (development version)
 
+* New `roffset()` for creating an rschedule with events that are offset from an
+  existing rschedule (#94).
+
+* The `offset` argument of `recur_on_easter()` is deprecated in favor of using
+  `roffset()` (#94).
+
 * All almanac class names are now prefixed with `almanac_*` to avoid potential
   clashes with other packages.
 

R/recur-on-easter.R

@@ -1,15 +1,17 @@
 #' Recur on easter
 #'
 #' `recur_on_easter()` is a special helper to recur on Easter. Easter is
-#' particularly difficult to construct a recurrence rule for. Using `offset`,
-#' this can also be used to generate a recurrence rule on Easter Monday or
-#' Good Friday.
+#' particularly difficult to construct a recurrence rule for.
 #'
 #' @param x `[rrule]`
 #'
 #'    A recurrence rule.
 #'
-#' @param offset `[integer(1)]`
+#' @param offset `r lifecycle::badge("deprecated")`
+#'
+#'    `[integer(1)]`
+#'
+#'    Deprecated in favor of using [roffset()] directly.
 #'
 #'    An offset in terms of a number of days on either side of Easter to recur
 #'    on. This offset must still fall within the same year, otherwise the date
@@ -21,26 +23,35 @@
 #' @export
 #' @examples
 #' on_easter <- yearly() %>% recur_on_easter()
-#' on_easter_monday <- yearly() %>% recur_on_easter(-1)
-#'
-#' alma_search("1999-01-01", "2001-01-01", on_easter)
 #'
-#' rb <- runion(on_easter, on_easter_monday)
+#' # Rather than:
+#' if (FALSE) {
+#' on_easter_monday <- yearly() %>% recur_on_easter(1)
+#' }
 #'
-#' alma_search("1999-01-01", "2001-01-01", rb)
+#' # Please use:
+#' on_easter_monday <- roffset(on_easter, 1)
 #'
+#' alma_search("1999-01-01", "2001-01-01", on_easter)
 #'
-#' # Note that `offset` must land within the same year, otherwise the date
-#' # is ignored
-#' on_easter_back_93_days <- yearly() %>% recur_on_easter(-93)
-#' on_easter_back_94_days <- yearly() %>% recur_on_easter(-94)
+#' both <- runion(on_easter, on_easter_monday)
 #'
-#' alma_search("1999-01-01", "2001-01-01", on_easter_back_93_days)
-#' alma_search("1999-01-01", "2001-01-01", on_easter_back_94_days)
-recur_on_easter <- function(x, offset = 0L) {
+#' alma_search("1999-01-01", "2001-01-01", both)
+recur_on_easter <- function(x, offset = NULL) {
   check_rrule(x)
   check_rule_not_set(x, "easter")
 
+  if (is_null(offset)) {
+    offset <- 0L
+  } else {
+    lifecycle::deprecate_warn(
+      when = "1.0.0",
+      what = "recur_on_easter(offset =)",
+      with = "roffset()",
+      always = TRUE
+    )
+  }
+
   check_number_whole(offset, min = -366, max = 366)
   offset <- vec_cast(offset, to = integer())
 

R/roffset.R

@@ -0,0 +1,102 @@
+#' Create an offset rschedule
+#'
+#' @description
+#' `roffset()` creates a new rschedule with events that are _offset_ from an
+#' existing rschedule by a certain amount. This can be useful when generating
+#' relative events like "the day after Christmas."
+#'
+#' @param rschedule `[rschedule]`
+#'
+#'   An rschedule to offset.
+#'
+#' @param by `[integer(1)]`
+#'
+#'   A single integer to offset by.
+#'
+#' @return
+#' An offset rschedule.
+#'
+#' @export
+#' @examples
+#' on_christmas <- yearly() %>%
+#'   recur_on_month_of_year("Dec") %>%
+#'   recur_on_day_of_month(25)
+#'
+#' on_day_after_christmas <- roffset(on_christmas, by = 1)
+#'
+#' alma_search("2018-01-01", "2023-01-01", on_day_after_christmas)
+#'
+#' # Now what if you want the observed holiday representing the day after
+#' # Christmas?
+#' on_weekends <- weekly() %>% recur_on_weekends()
+#'
+#' # Adjust Christmas to the nearest weekday
+#' on_christmas <- radjusted(on_christmas, on_weekends, adj_nearest)
+#'
+#' # Offset by 1 and then adjust that to the following weekday.
+#' # We never adjust backwards because that can coincide with the observed day
+#' # for Christmas.
+#' on_day_after_christmas <- on_christmas %>%
+#'   roffset(by = 1) %>%
+#'   radjusted(on_weekends, adj_following)
+#'
+#' # Note that:
+#' # - A Christmas on Friday the 24th resulted in a day after Christmas of
+#' #   Monday the 27th
+#' # - A Christmas on Monday the 26th resulted in a day after Christmas of
+#' #   Tuesday the 27th
+#' christmas <- alma_search("2018-01-01", "2023-01-01", on_christmas)
+#' day_after_christmas <- alma_search("2018-01-01", "2023-01-01", on_day_after_christmas)
+#'
+#' lubridate::wday(christmas, label = TRUE)
+#' lubridate::wday(day_after_christmas, label = TRUE)
+roffset <- function(rschedule, by) {
+  check_rschedule(rschedule)
+
+  check_number_whole(by)
+  by <- vec_cast(by, to = integer())
+
+  new_roffset(rschedule, by)
+}
+
+new_roffset <- function(rschedule, by, ..., class = character()) {
+  new_rschedule(
+    rschedule = rschedule,
+    by = by,
+    ...,
+    class = c(class, "almanac_roffset")
+  )
+}
+
+#' @export
+print.almanac_roffset <- function(x, ...) {
+  by <- roffset_by(x)
+  rschedule <- roffset_rschedule(x)
+
+  cli::cli_text("<roffset[by = {by}]>")
+
+  cli_indented()
+  print(rschedule)
+  cli::cli_end()
+
+  invisible(x)
+}
+
+#' @export
+rschedule_events.almanac_roffset <- function(x) {
+  by <- roffset_by(x)
+  rschedule <- roffset_rschedule(x)
+
+  events <- rschedule_events(rschedule)
+  events <- events + by
+
+  events
+}
+
+roffset_rschedule <- function(x) {
+  x$rschedule
+}
+
+roffset_by <- function(x) {
+  x$by
+}

R/rrule-print.R

@@ -167,5 +167,9 @@ format_easter <- function(x) {
     return(character())
   }
 
-  cli::format_inline("easter: offset = {easter}")
+  if (identical(easter, 0L)) {
+    cli::format_inline("easter")
+  } else {
+    cli::format_inline("easter: offset = {easter}")
+  }
 }

_pkgdown.yml

@@ -16,6 +16,7 @@ reference:
   - rintersect
   - rsetdiff
   - rcustom
+  - roffset
   - radjusted
 
 - title: Recurrence utilities

tests/testthat/_snaps/recur-on-easter.md

@@ -6,6 +6,21 @@
       Error in `recur_on_easter()`:
       ! The "easter" rule is already set and can't be set twice.
 
+# `offset` is deprecated
+
+    Code
+      recur_on_easter(yearly(), offset = 2)
+    Condition
+      Warning:
+      The `offset` argument of `recur_on_easter()` is deprecated as of almanac 1.0.0.
+      i Please use `roffset()` instead.
+    Message
+      <rrule>
+      * frequency: yearly
+      * since: 1900-01-01
+      * until: 2100-01-01
+      * easter: offset = 2
+
 # offset must be integerish
 
     Code