Add vec-ptype method for year-quarter-day

Author: DavisVaughan

NAMESPACE

@@ -433,6 +433,7 @@ 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_ptype,clock_year_quarter_day)
 S3method(vec_ptype2,clock_duration.clock_duration)
 S3method(vec_ptype2,clock_iso_year_week_day.clock_iso_year_week_day)
 S3method(vec_ptype2,clock_naive_time.clock_naive_time)

R/quarterly-year-quarter-day.R

@@ -175,6 +175,33 @@ is_year_quarter_day <- function(x) {
 
 # ------------------------------------------------------------------------------
 
+#' @export
+vec_ptype.clock_year_quarter_day <- function(x, ...) {
+  names <- NULL
+  precision <- calendar_precision(x)
+  start <- quarterly_start(x)
+
+  f <- integer()
+
+  fields <- switch(
+    precision + 1L,
+    list(year = f),
+    list(year = f, quarter = f),
+    abort("Internal error: Invalid precision"),
+    abort("Internal error: Invalid precision"),
+    list(year = f, quarter = f, day = f),
+    list(year = f, quarter = f, day = f, hour = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f, subsecond = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f, subsecond = f),
+    list(year = f, quarter = f, day = f, hour = f, minute = f, second = f, subsecond = f),
+    abort("Internal error: Invalid precision.")
+  )
+
+  new_year_quarter_day_from_fields(fields, precision, start, names)
+}
+
 #' @export
 vec_ptype2.clock_year_quarter_day.clock_year_quarter_day <- function(x, y, ...) {
   if (quarterly_start(x) != quarterly_start(y)) {

tests/testthat/test-quarterly-year-quarter-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 <- year_quarter_day(1)
+  ptype <- year_quarter_day(integer())
+
+  for (precision in precision_names()) {
+    if (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()