diff --git a/DESCRIPTION b/DESCRIPTION index ee8b2d09..d18adaf8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,7 @@ Depends: Imports: cli (>= 3.6.1), rlang (>= 1.1.0), - tzdb (>= 0.3.0), + tzdb (>= 0.3.0.9000), vctrs (>= 0.6.1) Suggests: covr, @@ -35,7 +35,7 @@ Suggests: withr LinkingTo: cpp11 (>= 0.4.3), - tzdb (>= 0.3.0) + tzdb (>= 0.3.0.9000) VignetteBuilder: knitr Config/Needs/website: @@ -46,3 +46,5 @@ Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 +Remotes: + r-lib/tzdb diff --git a/NAMESPACE b/NAMESPACE index dc473c4f..94314086 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -209,6 +209,7 @@ S3method(calendar_is_valid_precision,clock_year_month_weekday) S3method(calendar_is_valid_precision,clock_year_quarter_day) S3method(calendar_is_valid_precision,clock_year_week_day) S3method(calendar_leap_year,clock_calendar) +S3method(calendar_leap_year,clock_iso_year_week_day) S3method(calendar_leap_year,clock_year_day) S3method(calendar_leap_year,clock_year_month_day) S3method(calendar_leap_year,clock_year_month_weekday) diff --git a/NEWS.md b/NEWS.md index c26e7887..64689251 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,7 +8,8 @@ the Epidemiological calendar used by the US CDC guidelines (similar to what is supported by `lubridate::epiweek()` and `lubridate::epiyear()`) (#110). -* `calendar_leap_year()` now supports the year-quarter-day calendar (#332). +* `calendar_leap_year()` now supports the year-quarter-day and iso-year-week-day + calendars (#332, #333). * Documented clock's current stance on leap seconds in the FAQ vignette (clock ignores them like POSIXct) (#309). diff --git a/R/calendar.R b/R/calendar.R index 7be38ad1..fc8b0e47 100644 --- a/R/calendar.R +++ b/R/calendar.R @@ -72,9 +72,11 @@ cast_calendar_to_calendar <- function(x, to, ...) { #' #' - [year_month_weekday()]: February has a weekday that occurs 5 times. #' -#' - [year_week_day()]: There are 53 weeks in the year. +#' - [year_week_day()]: There are 53 weeks in the year, resulting in 371 +#' days in the year. #' -#' - [year_day()]: There are 366 days in the year. +#' - [iso_year_week_day()]: There are 53 weeks in the year, resulting in 371 +#' days in the year. #' #' - [year_quarter_day()]: One of the quarters has 1 more day than normal (the #' quarter with an extra day depends on the `start` used, but will always be @@ -82,6 +84,8 @@ cast_calendar_to_calendar <- function(x, to, ...) { #' for all `start`s except February, in which case the leap year is always 1 #' year after the Gregorian leap year. #' +#' - [year_day()]: There are 366 days in the year. +#' #' @param x `[calendar]` #' #' A calendar type to detect leap years in. diff --git a/R/cpp11.R b/R/cpp11.R index f111aba3..72745d5b 100644 --- a/R/cpp11.R +++ b/R/cpp11.R @@ -316,6 +316,10 @@ iso_year_week_day_minus_iso_year_week_day_cpp <- function(x, y, precision_int) { .Call(`_clock_iso_year_week_day_minus_iso_year_week_day_cpp`, x, y, precision_int) } +iso_year_week_day_leap_year_cpp <- function(year) { + .Call(`_clock_iso_year_week_day_leap_year_cpp`, year) +} + clock_get_year_max <- function() { .Call(`_clock_clock_get_year_max`) } diff --git a/R/iso-year-week-day.R b/R/iso-year-week-day.R index a7be0811..87ad2071 100644 --- a/R/iso-year-week-day.R +++ b/R/iso-year-week-day.R @@ -786,6 +786,14 @@ as.character.clock_iso_year_week_day <- function(x, ...) { # ------------------------------------------------------------------------------ +#' @export +calendar_leap_year.clock_iso_year_week_day <- function(x) { + year <- get_year(x) + iso_year_week_day_leap_year_cpp(year) +} + +# ------------------------------------------------------------------------------ + #' Grouping: iso-year-week-day #' #' @description diff --git a/man/calendar_leap_year.Rd b/man/calendar_leap_year.Rd index d82afe01..3f755732 100644 --- a/man/calendar_leap_year.Rd +++ b/man/calendar_leap_year.Rd @@ -23,13 +23,16 @@ A particular year is a leap year if: \itemize{ \item \code{\link[=year_month_day]{year_month_day()}}: February has 29 days. \item \code{\link[=year_month_weekday]{year_month_weekday()}}: February has a weekday that occurs 5 times. -\item \code{\link[=year_week_day]{year_week_day()}}: There are 53 weeks in the year. -\item \code{\link[=year_day]{year_day()}}: There are 366 days in the year. +\item \code{\link[=year_week_day]{year_week_day()}}: There are 53 weeks in the year, resulting in 371 +days in the year. +\item \code{\link[=iso_year_week_day]{iso_year_week_day()}}: There are 53 weeks in the year, resulting in 371 +days in the year. \item \code{\link[=year_quarter_day]{year_quarter_day()}}: One of the quarters has 1 more day than normal (the quarter with an extra day depends on the \code{start} used, but will always be the same for a particular \code{start}). This aligns with Gregorian leap years for all \code{start}s except February, in which case the leap year is always 1 year after the Gregorian leap year. +\item \code{\link[=year_day]{year_day()}}: There are 366 days in the year. } } \examples{ diff --git a/src/cpp11.cpp b/src/cpp11.cpp index e7aa5453..1c150353 100644 --- a/src/cpp11.cpp +++ b/src/cpp11.cpp @@ -558,6 +558,13 @@ extern "C" SEXP _clock_iso_year_week_day_minus_iso_year_week_day_cpp(SEXP x, SEX return cpp11::as_sexp(iso_year_week_day_minus_iso_year_week_day_cpp(cpp11::as_cpp>>(x), cpp11::as_cpp>>(y), cpp11::as_cpp>(precision_int))); END_CPP11 } +// iso-year-week-day.cpp +cpp11::writable::logicals iso_year_week_day_leap_year_cpp(const cpp11::integers& year); +extern "C" SEXP _clock_iso_year_week_day_leap_year_cpp(SEXP year) { + BEGIN_CPP11 + return cpp11::as_sexp(iso_year_week_day_leap_year_cpp(cpp11::as_cpp>(year))); + END_CPP11 +} // limits.cpp int clock_get_year_max(); extern "C" SEXP _clock_clock_get_year_max() { @@ -1018,6 +1025,7 @@ static const R_CallMethodDef CallEntries[] = { {"_clock_invalid_resolve_year_month_weekday_cpp", (DL_FUNC) &_clock_invalid_resolve_year_month_weekday_cpp, 3}, {"_clock_invalid_resolve_year_quarter_day_cpp", (DL_FUNC) &_clock_invalid_resolve_year_quarter_day_cpp, 4}, {"_clock_invalid_resolve_year_week_day_cpp", (DL_FUNC) &_clock_invalid_resolve_year_week_day_cpp, 4}, + {"_clock_iso_year_week_day_leap_year_cpp", (DL_FUNC) &_clock_iso_year_week_day_leap_year_cpp, 1}, {"_clock_iso_year_week_day_minus_iso_year_week_day_cpp", (DL_FUNC) &_clock_iso_year_week_day_minus_iso_year_week_day_cpp, 3}, {"_clock_iso_year_week_day_plus_duration_cpp", (DL_FUNC) &_clock_iso_year_week_day_plus_duration_cpp, 4}, {"_clock_iso_year_week_day_restore", (DL_FUNC) &_clock_iso_year_week_day_restore, 2}, diff --git a/src/iso-year-week-day.cpp b/src/iso-year-week-day.cpp index 3472e760..f1b15262 100644 --- a/src/iso-year-week-day.cpp +++ b/src/iso-year-week-day.cpp @@ -414,3 +414,24 @@ iso_year_week_day_minus_iso_year_week_day_cpp(cpp11::list_of x, never_reached("iso_year_week_day_minus_iso_year_week_day_cpp"); } + +// ----------------------------------------------------------------------------- + +[[cpp11::register]] +cpp11::writable::logicals +iso_year_week_day_leap_year_cpp(const cpp11::integers& year) { + const r_ssize size = year.size(); + cpp11::writable::logicals out(size); + + for (r_ssize i = 0; i < size; ++i) { + const int elt = year[i]; + + if (elt == r_int_na) { + out[i] = r_lgl_na; + } else { + out[i] = iso_week::year{elt}.is_leap(); + } + } + + return out; +} diff --git a/tests/testthat/test-iso-year-week-day.R b/tests/testthat/test-iso-year-week-day.R index 9a0010dd..56ae36d8 100644 --- a/tests/testthat/test-iso-year-week-day.R +++ b/tests/testthat/test-iso-year-week-day.R @@ -386,6 +386,27 @@ test_that("can compute week end", { expect_identical(calendar_end(x, "week"), expect) }) +# ------------------------------------------------------------------------------ +# calendar_leap_year() + +test_that("can detect leap years", { + # Exactly 71 leap weeks for any 400 year cycle + start <- 1900L + + while (start < 2000L) { + # `- 1L` to have exactly 400 years considered in the range since both + # `start` and `end` are included by `seq()` + end <- start + 400L - 1L + x <- iso_year_week_day(seq(start, end)) + expect_identical(sum(calendar_leap_year(x)), 71L) + start <- start + 1L + } +}) + +test_that("`NA` propagates", { + expect_identical(calendar_leap_year(iso_year_week_day(NA)), NA) +}) + # ------------------------------------------------------------------------------ # calendar_count_between()