Add vec-ptype method for year-day

Author: DavisVaughan

NAMESPACE

@@ -481,6 +481,7 @@ S3method(vec_ptype,clock_iso_year_week_day)
 S3method(vec_ptype,clock_naive_time)
 S3method(vec_ptype,clock_sys_time)
 S3method(vec_ptype,clock_weekday)
+S3method(vec_ptype,clock_year_day)
 S3method(vec_ptype,clock_year_month_day)
 S3method(vec_ptype,clock_year_month_weekday)
 S3method(vec_ptype,clock_year_quarter_day)

R/gregorian-year-day.R

@@ -137,6 +137,25 @@ is_year_day <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_year_day <- function(x, ...) {
+  switch(
+    calendar_precision(x) + 1L,
+    clock_empty_year_day_year,
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    clock_empty_year_day_day,
+    clock_empty_year_day_hour,
+    clock_empty_year_day_minute,
+    clock_empty_year_day_second,
+    clock_empty_year_day_millisecond,
+    clock_empty_year_day_microsecond,
+    clock_empty_year_day_nanosecond,
+    abort("Internal error: Invalid precision.")
+  )
+}
+
 #' @export
 vec_ptype2.clock_year_day.clock_year_day <- function(x, y, ...) {
   ptype2_calendar_and_calendar(x, y, ...)
@@ -903,3 +922,20 @@ seq.clock_year_day <- function(from,
     ...
   )
 }
+
+# ------------------------------------------------------------------------------
+
+clock_init_year_day_utils <- function(env) {
+  year <- year_day(integer())
+
+  assign("clock_empty_year_day_year", year, envir = env)
+  assign("clock_empty_year_day_day", calendar_widen(year, "day"), envir = env)
+  assign("clock_empty_year_day_hour", calendar_widen(year, "hour"), envir = env)
+  assign("clock_empty_year_day_minute", calendar_widen(year, "minute"), envir = env)
+  assign("clock_empty_year_day_second", calendar_widen(year, "second"), envir = env)
+  assign("clock_empty_year_day_millisecond", calendar_widen(year, "millisecond"), envir = env)
+  assign("clock_empty_year_day_microsecond", calendar_widen(year, "microsecond"), envir = env)
+  assign("clock_empty_year_day_nanosecond", calendar_widen(year, "nanosecond"), envir = env)
+
+  invisible(NULL)
+}

R/zzz.R

@@ -12,6 +12,7 @@
   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)
+  clock_init_year_day_utils(clock_ns)
   clock_init_sys_time_utils(clock_ns)
   clock_init_naive_time_utils(clock_ns)
   clock_init_zoned_time_utils(clock_ns)

tests/testthat/test-gregorian-year-day.R

@@ -58,6 +58,25 @@ test_that("names of `year` are not retained", {
   expect_named(year_day(c(x = 1)), NULL)
 })
 
+# ------------------------------------------------------------------------------
+# vec_ptype()
+
+test_that("ptype is correct", {
+  base <- year_day(1)
+  ptype <- year_day(integer())
+
+  for (precision in precision_names()) {
+    if (precision == "quarter" || precision == "month" || precision == "week") {
+      next
+    }
+
+    x <- calendar_widen(base, precision)
+    expect <- calendar_widen(ptype, precision)
+
+    expect_identical(vec_ptype(x), expect)
+  }
+})
+
 # ------------------------------------------------------------------------------
 # vec_proxy() / vec_restore()