Add vec-ptype method for iso-year-week-day

Author: DavisVaughan

NAMESPACE

@@ -430,6 +430,7 @@ S3method(vec_proxy,clock_year_quarter_day)
 S3method(vec_proxy,clock_zoned_time)
 S3method(vec_proxy_compare,clock_weekday)
 S3method(vec_proxy_compare,clock_year_month_weekday)
+S3method(vec_ptype,clock_iso_year_week_day)
 S3method(vec_ptype,clock_year_month_day)
 S3method(vec_ptype,clock_year_month_weekday)
 S3method(vec_ptype2,clock_duration.clock_duration)

R/iso-year-week-day.R

@@ -152,6 +152,25 @@ is_iso_year_week_day <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_iso_year_week_day <- function(x, ...) {
+  switch(
+    calendar_precision(x) + 1L,
+    clock_empty_iso_year_week_day_year,
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    clock_empty_iso_year_week_day_week,
+    clock_empty_iso_year_week_day_day,
+    clock_empty_iso_year_week_day_hour,
+    clock_empty_iso_year_week_day_minute,
+    clock_empty_iso_year_week_day_second,
+    clock_empty_iso_year_week_day_millisecond,
+    clock_empty_iso_year_week_day_microsecond,
+    clock_empty_iso_year_week_day_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_iso_year_week_day.clock_iso_year_week_day <- function(x, y, ...) {
   ptype2_calendar_and_calendar(x, y, ...)
@@ -916,3 +935,21 @@ seq.clock_iso_year_week_day <- function(from,
     ...
   )
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_iso_year_week_day_utils <- function(env) {
+  year <- iso_year_week_day(integer())
+
+  assign("clock_empty_iso_year_week_day_year", year, envir = env)
+  assign("clock_empty_iso_year_week_day_week", calendar_widen(year, "week"), envir = env)
+  assign("clock_empty_iso_year_week_day_day", calendar_widen(year, "day"), envir = env)
+  assign("clock_empty_iso_year_week_day_hour", calendar_widen(year, "hour"), envir = env)
+  assign("clock_empty_iso_year_week_day_minute", calendar_widen(year, "minute"), envir = env)
+  assign("clock_empty_iso_year_week_day_second", calendar_widen(year, "second"), envir = env)
+  assign("clock_empty_iso_year_week_day_millisecond", calendar_widen(year, "millisecond"), envir = env)
+  assign("clock_empty_iso_year_week_day_microsecond", calendar_widen(year, "microsecond"), envir = env)
+  assign("clock_empty_iso_year_week_day_nanosecond", calendar_widen(year, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/zzz.R

@@ -11,6 +11,7 @@
   # Initializers must run after initializing C++ utils and setting tzdata
   clock_init_year_month_day_utils(clock_ns)
   clock_init_year_month_weekday_utils(clock_ns)
+  clock_init_iso_year_week_day_utils(clock_ns)
 
   vctrs::s3_register("pillar::pillar_shaft", "clock_calendar", pillar_shaft.clock_calendar)
   vctrs::s3_register("pillar::pillar_shaft", "clock_time_point", pillar_shaft.clock_time_point)

tests/testthat/test-iso-year-week-day.R

@@ -47,6 +47,25 @@ test_that("NA values propagate", {
   expect_identical(is.na(x), c(TRUE, FALSE, TRUE))
 })
 
+# ------------------------------------------------------------------------------
+# vec_ptype()
+
+test_that("ptype is correct", {
+  base <- iso_year_week_day(1)
+  ptype <- iso_year_week_day(integer())
+
+  for (precision in precision_names()) {
+    if (precision == "quarter" || precision == "month") {
+      next
+    }
+
+    x <- calendar_widen(base, precision)
+    expect <- calendar_widen(ptype, precision)
+
+    expect_identical(vec_ptype(x), expect)
+  }
+})
+
 # ------------------------------------------------------------------------------
 # vec_proxy() / vec_restore()