From e90f0109d36071d3c1019f0de03a8f06bac22c9d Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 10:44:41 -0500 Subject: [PATCH 01/10] Rely on vctrs PR --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 91978a97..f074d3ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -43,7 +43,7 @@ VignetteBuilder: knitr Remotes: r-lib/tzdb, - r-lib/vctrs + r-lib/vctrs#1322 Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true From 591e69ebdeda95f4587981a3f0d1f350c3183c1a Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 10:46:05 -0500 Subject: [PATCH 02/10] Add `precision_names()` helper --- R/precision.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/R/precision.R b/R/precision.R index d4b0d517..12796f7d 100644 --- a/R/precision.R +++ b/R/precision.R @@ -62,3 +62,19 @@ precision_common2 <- function(x, y) { y } } + +precision_names <- function() { + c( + "year", + "quarter", + "month", + "week", + "day", + "hour", + "minute", + "second", + "millisecond", + "microsecond", + "nanosecond" + ) +} From a5a9cf65fc25bbd973d3dd554ebd0b180d4b9c3d Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 10:46:17 -0500 Subject: [PATCH 03/10] Add vec-ptype method for year-month-day --- NAMESPACE | 1 + R/gregorian-year-month-day.R | 37 +++++++++++++++++++ R/zzz.R | 5 +++ .../testthat/test-gregorian-year-month-day.R | 19 ++++++++++ 4 files changed, 62 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 0835445b..c4f9302b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -477,6 +477,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_year_month_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) diff --git a/R/gregorian-year-month-day.R b/R/gregorian-year-month-day.R index ee642a64..772317a4 100644 --- a/R/gregorian-year-month-day.R +++ b/R/gregorian-year-month-day.R @@ -323,6 +323,25 @@ is_year_month_day <- function(x) { # ------------------------------------------------------------------------------ +#' @export +vec_ptype.clock_year_month_day <- function(x, ...) { + switch( + calendar_precision(x) + 1L, + clock_empty_year_month_day_year, + abort("Internal error: Invalid precision"), + clock_empty_year_month_day_month, + abort("Internal error: Invalid precision"), + clock_empty_year_month_day_day, + clock_empty_year_month_day_hour, + clock_empty_year_month_day_minute, + clock_empty_year_month_day_second, + clock_empty_year_month_day_millisecond, + clock_empty_year_month_day_microsecond, + clock_empty_year_month_day_nanosecond, + abort("Internal error: Invalid precision.") + ) +} + #' @export vec_ptype2.clock_year_month_day.clock_year_month_day <- function(x, y, ...) { ptype2_calendar_and_calendar(x, y, ...) @@ -1183,3 +1202,21 @@ seq.clock_year_month_day <- function(from, ... ) } + +# ------------------------------------------------------------------------------ + +clock_init_year_month_day_utils <- function(env) { + year <- year_month_day(integer()) + + assign("clock_empty_year_month_day_year", year, envir = env) + assign("clock_empty_year_month_day_month", calendar_widen(year, "month"), envir = env) + assign("clock_empty_year_month_day_day", calendar_widen(year, "day"), envir = env) + assign("clock_empty_year_month_day_hour", calendar_widen(year, "hour"), envir = env) + assign("clock_empty_year_month_day_minute", calendar_widen(year, "minute"), envir = env) + assign("clock_empty_year_month_day_second", calendar_widen(year, "second"), envir = env) + assign("clock_empty_year_month_day_millisecond", calendar_widen(year, "millisecond"), envir = env) + assign("clock_empty_year_month_day_microsecond", calendar_widen(year, "microsecond"), envir = env) + assign("clock_empty_year_month_day_nanosecond", calendar_widen(year, "nanosecond"), envir = env) + + invisible(NULL) +} diff --git a/R/zzz.R b/R/zzz.R index 6170d1a2..95f89f0f 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -6,6 +6,11 @@ tzdata <- tzdb::tzdb_path(type = "text") clock_set_install(tzdata) + clock_ns <- topenv(environment()) + + # Initializers must run after initializing C++ utils and setting tzdata + clock_init_year_month_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) vctrs::s3_register("pillar::pillar_shaft", "clock_zoned_time", pillar_shaft.clock_zoned_time) diff --git a/tests/testthat/test-gregorian-year-month-day.R b/tests/testthat/test-gregorian-year-month-day.R index 3b519144..948fba22 100644 --- a/tests/testthat/test-gregorian-year-month-day.R +++ b/tests/testthat/test-gregorian-year-month-day.R @@ -59,6 +59,25 @@ test_that("names of `year` are not retained", { expect_named(year_month_day(c(x = 1)), NULL) }) +# ------------------------------------------------------------------------------ +# vec_ptype() + +test_that("ptype is correct", { + base <- year_month_day(1) + ptype <- year_month_day(integer()) + + for (precision in precision_names()) { + if (precision == "quarter" || precision == "week") { + next + } + + x <- calendar_widen(base, precision) + expect <- calendar_widen(ptype, precision) + + expect_identical(vec_ptype(x), expect) + } +}) + # ------------------------------------------------------------------------------ # vec_proxy() / vec_restore() From 1bb570edda003090edbccf83e22882d3742c3f97 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 10:50:14 -0500 Subject: [PATCH 04/10] Add vec-ptype method for year-month-weekday --- NAMESPACE | 1 + R/gregorian-year-month-weekday.R | 37 +++++++++++++++++++ R/zzz.R | 1 + .../test-gregorian-year-month-weekday.R | 19 ++++++++++ 4 files changed, 58 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index c4f9302b..2a6ec6fb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -478,6 +478,7 @@ S3method(vec_proxy,clock_zoned_time) S3method(vec_proxy_compare,clock_weekday) S3method(vec_proxy_compare,clock_year_month_weekday) S3method(vec_ptype,clock_year_month_day) +S3method(vec_ptype,clock_year_month_weekday) 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) diff --git a/R/gregorian-year-month-weekday.R b/R/gregorian-year-month-weekday.R index 0aad6d8d..155a6178 100644 --- a/R/gregorian-year-month-weekday.R +++ b/R/gregorian-year-month-weekday.R @@ -175,6 +175,25 @@ is_year_month_weekday <- function(x) { # ------------------------------------------------------------------------------ +#' @export +vec_ptype.clock_year_month_weekday <- function(x, ...) { + switch( + calendar_precision(x) + 1L, + clock_empty_year_month_weekday_year, + abort("Internal error: Invalid precision"), + clock_empty_year_month_weekday_month, + abort("Internal error: Invalid precision"), + clock_empty_year_month_weekday_day, + clock_empty_year_month_weekday_hour, + clock_empty_year_month_weekday_minute, + clock_empty_year_month_weekday_second, + clock_empty_year_month_weekday_millisecond, + clock_empty_year_month_weekday_microsecond, + clock_empty_year_month_weekday_nanosecond, + abort("Internal error: Invalid precision.") + ) +} + #' @export vec_ptype2.clock_year_month_weekday.clock_year_month_weekday <- function(x, y, ...) { ptype2_calendar_and_calendar(x, y, ...) @@ -1050,3 +1069,21 @@ seq.clock_year_month_weekday <- function(from, ...) { seq.clock_year_month_day(from, to, by, length.out, along.with, ...) } + +# ------------------------------------------------------------------------------ + +clock_init_year_month_weekday_utils <- function(env) { + year <- year_month_weekday(integer()) + + assign("clock_empty_year_month_weekday_year", year, envir = env) + assign("clock_empty_year_month_weekday_month", calendar_widen(year, "month"), envir = env) + assign("clock_empty_year_month_weekday_day", calendar_widen(year, "day"), envir = env) + assign("clock_empty_year_month_weekday_hour", calendar_widen(year, "hour"), envir = env) + assign("clock_empty_year_month_weekday_minute", calendar_widen(year, "minute"), envir = env) + assign("clock_empty_year_month_weekday_second", calendar_widen(year, "second"), envir = env) + assign("clock_empty_year_month_weekday_millisecond", calendar_widen(year, "millisecond"), envir = env) + assign("clock_empty_year_month_weekday_microsecond", calendar_widen(year, "microsecond"), envir = env) + assign("clock_empty_year_month_weekday_nanosecond", calendar_widen(year, "nanosecond"), envir = env) + + invisible(NULL) +} diff --git a/R/zzz.R b/R/zzz.R index 95f89f0f..4cbb5afc 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -10,6 +10,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) 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) diff --git a/tests/testthat/test-gregorian-year-month-weekday.R b/tests/testthat/test-gregorian-year-month-weekday.R index 7a95b267..77325df7 100644 --- a/tests/testthat/test-gregorian-year-month-weekday.R +++ b/tests/testthat/test-gregorian-year-month-weekday.R @@ -53,6 +53,25 @@ test_that("NA values propagate", { expect_identical(is.na(x), c(TRUE, FALSE, TRUE)) }) +# ------------------------------------------------------------------------------ +# vec_ptype() + +test_that("ptype is correct", { + base <- year_month_weekday(1) + ptype <- year_month_weekday(integer()) + + for (precision in precision_names()) { + if (precision == "quarter" || precision == "week") { + next + } + + x <- calendar_widen(base, precision) + expect <- calendar_widen(ptype, precision) + + expect_identical(vec_ptype(x), expect) + } +}) + # ------------------------------------------------------------------------------ # vec_proxy() / vec_restore() From 244aad696295312c4c2e3af462614e32fa9a8819 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 10:53:29 -0500 Subject: [PATCH 05/10] Add vec-ptype method for iso-year-week-day --- NAMESPACE | 1 + R/iso-year-week-day.R | 37 +++++++++++++++++++++++++ R/zzz.R | 1 + tests/testthat/test-iso-year-week-day.R | 19 +++++++++++++ 4 files changed, 58 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 2a6ec6fb..cd3e7fe8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -477,6 +477,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) diff --git a/R/iso-year-week-day.R b/R/iso-year-week-day.R index 101da9c8..f6cd2575 100644 --- a/R/iso-year-week-day.R +++ b/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) +} diff --git a/R/zzz.R b/R/zzz.R index 4cbb5afc..bdaece2e 100644 --- a/R/zzz.R +++ b/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) diff --git a/tests/testthat/test-iso-year-week-day.R b/tests/testthat/test-iso-year-week-day.R index 34d12892..0e38d299 100644 --- a/tests/testthat/test-iso-year-week-day.R +++ b/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() From 8c49d686c221d67bebe5e12617a9f54982cd8e93 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 12:47:51 -0500 Subject: [PATCH 06/10] Add vec-ptype method for year-quarter-day --- NAMESPACE | 1 + R/quarterly-year-quarter-day.R | 27 +++++++++++++++++++ .../test-quarterly-year-quarter-day.R | 19 +++++++++++++ 3 files changed, 47 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index cd3e7fe8..99870c61 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -480,6 +480,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) diff --git a/R/quarterly-year-quarter-day.R b/R/quarterly-year-quarter-day.R index 0f3e19a7..b0a3b1b7 100644 --- a/R/quarterly-year-quarter-day.R +++ b/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)) { diff --git a/tests/testthat/test-quarterly-year-quarter-day.R b/tests/testthat/test-quarterly-year-quarter-day.R index dc4f120b..f75db080 100644 --- a/tests/testthat/test-quarterly-year-quarter-day.R +++ b/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() From d9748e981f3a1a217f98acf52a141a629015bbcc Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 12:56:37 -0500 Subject: [PATCH 07/10] Add vec-ptype method for sys-time and naive-time --- NAMESPACE | 2 ++ R/naive-time.R | 35 ++++++++++++++++++++++++++++++++ R/sys-time.R | 34 +++++++++++++++++++++++++++++++ R/zzz.R | 2 ++ tests/testthat/test-naive-time.R | 19 +++++++++++++++++ tests/testthat/test-sys-time.R | 19 +++++++++++++++++ 6 files changed, 111 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 99870c61..ce760c29 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -478,6 +478,8 @@ 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_naive_time) +S3method(vec_ptype,clock_sys_time) S3method(vec_ptype,clock_year_month_day) S3method(vec_ptype,clock_year_month_weekday) S3method(vec_ptype,clock_year_quarter_day) diff --git a/R/naive-time.R b/R/naive-time.R index 80672a8a..2108d507 100644 --- a/R/naive-time.R +++ b/R/naive-time.R @@ -697,6 +697,25 @@ new_naive_info_from_fields <- function(fields) { # ------------------------------------------------------------------------------ +#' @export +vec_ptype.clock_naive_time <- function(x, ...) { + switch( + time_point_precision(x) + 1L, + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + clock_empty_naive_time_day, + clock_empty_naive_time_hour, + clock_empty_naive_time_minute, + clock_empty_naive_time_second, + clock_empty_naive_time_millisecond, + clock_empty_naive_time_microsecond, + clock_empty_naive_time_nanosecond, + abort("Internal error: Invalid precision.") + ) +} + #' @export vec_ptype2.clock_naive_time.clock_naive_time <- function(x, y, ...) { ptype2_time_point_and_time_point(x, y, ...) @@ -751,3 +770,19 @@ vec_arith.clock_naive_time.numeric <- function(op, x, y, ...) { vec_arith.numeric.clock_naive_time <- function(op, x, y, ...) { arith_numeric_and_time_point(op, x, y, ...) } + +# ------------------------------------------------------------------------------ + +clock_init_naive_time_utils <- function(env) { + day <- as_naive(year_month_day(integer(), integer(), integer())) + + assign("clock_empty_naive_time_day", day, envir = env) + assign("clock_empty_naive_time_hour", time_point_cast(day, "hour"), envir = env) + assign("clock_empty_naive_time_minute", time_point_cast(day, "minute"), envir = env) + assign("clock_empty_naive_time_second", time_point_cast(day, "second"), envir = env) + assign("clock_empty_naive_time_millisecond", time_point_cast(day, "millisecond"), envir = env) + assign("clock_empty_naive_time_microsecond", time_point_cast(day, "microsecond"), envir = env) + assign("clock_empty_naive_time_nanosecond", time_point_cast(day, "nanosecond"), envir = env) + + invisible(NULL) +} diff --git a/R/sys-time.R b/R/sys-time.R index eb42d126..b2623156 100644 --- a/R/sys-time.R +++ b/R/sys-time.R @@ -416,6 +416,25 @@ new_sys_info_from_fields <- function(fields) { # ------------------------------------------------------------------------------ +#' @export +vec_ptype.clock_sys_time <- function(x, ...) { + switch( + time_point_precision(x) + 1L, + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + clock_empty_sys_time_day, + clock_empty_sys_time_hour, + clock_empty_sys_time_minute, + clock_empty_sys_time_second, + clock_empty_sys_time_millisecond, + clock_empty_sys_time_microsecond, + clock_empty_sys_time_nanosecond, + abort("Internal error: Invalid precision.") + ) +} + #' @export vec_ptype2.clock_sys_time.clock_sys_time <- function(x, y, ...) { ptype2_time_point_and_time_point(x, y, ...) @@ -471,3 +490,18 @@ vec_arith.numeric.clock_sys_time <- function(op, x, y, ...) { arith_numeric_and_time_point(op, x, y, ...) } +# ------------------------------------------------------------------------------ + +clock_init_sys_time_utils <- function(env) { + day <- as_sys(year_month_day(integer(), integer(), integer())) + + assign("clock_empty_sys_time_day", day, envir = env) + assign("clock_empty_sys_time_hour", time_point_cast(day, "hour"), envir = env) + assign("clock_empty_sys_time_minute", time_point_cast(day, "minute"), envir = env) + assign("clock_empty_sys_time_second", time_point_cast(day, "second"), envir = env) + assign("clock_empty_sys_time_millisecond", time_point_cast(day, "millisecond"), envir = env) + assign("clock_empty_sys_time_microsecond", time_point_cast(day, "microsecond"), envir = env) + assign("clock_empty_sys_time_nanosecond", time_point_cast(day, "nanosecond"), envir = env) + + invisible(NULL) +} diff --git a/R/zzz.R b/R/zzz.R index bdaece2e..493a5e44 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -12,6 +12,8 @@ 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_sys_time_utils(clock_ns) + clock_init_naive_time_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) diff --git a/tests/testthat/test-naive-time.R b/tests/testthat/test-naive-time.R index fefdf749..7c0bf017 100644 --- a/tests/testthat/test-naive-time.R +++ b/tests/testthat/test-naive-time.R @@ -495,3 +495,22 @@ test_that("strict mode can be activated - ambiguous", { expect_snapshot_error(as_zoned(naive_seconds(), zone, nonexistent = "roll-forward", ambiguous = zt)) expect_snapshot_error(as_zoned(naive_seconds(), zone, nonexistent = "roll-forward", ambiguous = list(zt, NULL))) }) + +# ------------------------------------------------------------------------------ +# vec_ptype() + +test_that("ptype is correct", { + base <- naive_days(0) + ptype <- naive_days(integer()) + + for (precision in precision_names()) { + if (validate_precision_string(precision) < PRECISION_DAY) { + next + } + + x <- time_point_cast(base, precision) + expect <- time_point_cast(ptype, precision) + + expect_identical(vec_ptype(x), expect) + } +}) diff --git a/tests/testthat/test-sys-time.R b/tests/testthat/test-sys-time.R index 5aa5fc5c..9c1f8358 100644 --- a/tests/testthat/test-sys-time.R +++ b/tests/testthat/test-sys-time.R @@ -119,3 +119,22 @@ test_that("failure to parse throws a warning", { expect_warning(sys_parse("foo"), class = "clock_warning_parse_failures") expect_snapshot(sys_parse("foo")) }) + +# ------------------------------------------------------------------------------ +# vec_ptype() + +test_that("ptype is correct", { + base <- sys_days(0) + ptype <- sys_days(integer()) + + for (precision in precision_names()) { + if (validate_precision_string(precision) < PRECISION_DAY) { + next + } + + x <- time_point_cast(base, precision) + expect <- time_point_cast(ptype, precision) + + expect_identical(vec_ptype(x), expect) + } +}) From 1b9104fd27bed8efe4fdc5a6beea8c36a8998a37 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 13:06:21 -0500 Subject: [PATCH 08/10] Add vec-ptype method for zoned-time --- NAMESPACE | 1 + R/zoned-time.R | 36 ++++++++++++++++++++++++++++++++ R/zzz.R | 1 + tests/testthat/test-zoned-time.R | 25 ++++++++++++++++++++++ 4 files changed, 63 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index ce760c29..a7ce3919 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -483,6 +483,7 @@ S3method(vec_ptype,clock_sys_time) S3method(vec_ptype,clock_year_month_day) S3method(vec_ptype,clock_year_month_weekday) S3method(vec_ptype,clock_year_quarter_day) +S3method(vec_ptype,clock_zoned_time) 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) diff --git a/R/zoned-time.R b/R/zoned-time.R index c063fc3e..0f8a2ec7 100644 --- a/R/zoned-time.R +++ b/R/zoned-time.R @@ -675,6 +675,31 @@ zone_pretty <- function(zone) { # ------------------------------------------------------------------------------ +#' @export +vec_ptype.clock_zoned_time <- function(x, ...) { + zone <- zoned_time_zone(x) + + ptype_utc <- switch( + zoned_time_precision(x) + 1L, + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + abort("Internal error: Invalid precision"), + clock_empty_zoned_time_utc_second, + clock_empty_zoned_time_utc_millisecond, + clock_empty_zoned_time_utc_microsecond, + clock_empty_zoned_time_utc_nanosecond, + abort("Internal error: Invalid precision.") + ) + + ptype <- zoned_time_set_zone(ptype_utc, zone) + + ptype +} + #' @export vec_ptype2.clock_zoned_time.clock_zoned_time <- function(x, y, ...) { x_zone <- zoned_time_zone(x) @@ -1015,3 +1040,14 @@ validate_zoned_time_precision_string <- function(precision) { is_valid_zoned_time_precision <- function(precision) { precision >= PRECISION_SECOND } + +# ------------------------------------------------------------------------------ + +clock_init_zoned_time_utils <- function(env) { + assign("clock_empty_zoned_time_utc_second", as_zoned(as_sys(duration_seconds()), "UTC"), envir = env) + assign("clock_empty_zoned_time_utc_millisecond", as_zoned(as_sys(duration_milliseconds()), "UTC"), envir = env) + assign("clock_empty_zoned_time_utc_microsecond", as_zoned(as_sys(duration_microseconds()), "UTC"), envir = env) + assign("clock_empty_zoned_time_utc_nanosecond", as_zoned(as_sys(duration_nanoseconds()), "UTC"), envir = env) + + invisible(NULL) +} diff --git a/R/zzz.R b/R/zzz.R index 493a5e44..5e584ac9 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -14,6 +14,7 @@ clock_init_iso_year_week_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) 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) diff --git a/tests/testthat/test-zoned-time.R b/tests/testthat/test-zoned-time.R index b78e52ba..daa5675c 100644 --- a/tests/testthat/test-zoned-time.R +++ b/tests/testthat/test-zoned-time.R @@ -407,3 +407,28 @@ test_that("zoned-times don't support arithmetic", { expect_snapshot_error(add_microseconds(x, 1)) expect_snapshot_error(add_nanoseconds(x, 1)) }) + +# ------------------------------------------------------------------------------ +# vec_ptype() + +test_that("ptype is correct", { + zones <- c("UTC", "America/New_York", "") + + for (zone in zones) { + for (precision in precision_names()) { + precision <- validate_precision_string(precision) + + if (precision < PRECISION_SECOND) { + next + } + + x <- duration_helper(0L, precision) + x <- as_zoned(as_naive(x), zone) + + ptype <- duration_helper(integer(), precision) + ptype <- as_zoned(as_naive(ptype), zone) + + expect_identical(vec_ptype(x), ptype) + } + } +}) From 52bd9f4c484eb2e02e0217ab46e9caa5d641ced5 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Thu, 25 Feb 2021 13:09:26 -0500 Subject: [PATCH 09/10] Add vec-ptype method for weekday --- NAMESPACE | 1 + R/weekday.R | 13 +++++++++++++ R/zzz.R | 1 + tests/testthat/test-weekday.R | 7 +++++++ 4 files changed, 22 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index a7ce3919..2567cb60 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -480,6 +480,7 @@ S3method(vec_proxy_compare,clock_year_month_weekday) 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_month_day) S3method(vec_ptype,clock_year_month_weekday) S3method(vec_ptype,clock_year_quarter_day) diff --git a/R/weekday.R b/R/weekday.R index 0f92ddb5..8fc166f2 100644 --- a/R/weekday.R +++ b/R/weekday.R @@ -157,6 +157,11 @@ vec_ptype_abbr.clock_weekday <- function(x, ...) { # ------------------------------------------------------------------------------ +#' @export +vec_ptype.clock_weekday <- function(x, ...) { + clock_empty_weekday +} + #' @export vec_ptype2.clock_weekday.clock_weekday <- function(x, y, ...) { x @@ -506,3 +511,11 @@ reencode_western_to_iso <- function(code) { code[code == 0L] <- 7L code } + +# ------------------------------------------------------------------------------ + +clock_init_weekday_utils <- function(env) { + assign("clock_empty_weekday", weekday(integer()), envir = env) + + invisible(NULL) +} diff --git a/R/zzz.R b/R/zzz.R index 5e584ac9..31e0fb68 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -15,6 +15,7 @@ clock_init_sys_time_utils(clock_ns) clock_init_naive_time_utils(clock_ns) clock_init_zoned_time_utils(clock_ns) + clock_init_weekday_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) diff --git a/tests/testthat/test-weekday.R b/tests/testthat/test-weekday.R index 363df049..61af795e 100644 --- a/tests/testthat/test-weekday.R +++ b/tests/testthat/test-weekday.R @@ -173,3 +173,10 @@ test_that("can't compare or order weekdays (#153)", { expect_snapshot_error(xtfrm(weekday(1:2))) expect_snapshot_error(vec_order(weekday(1:2))) }) + +# ------------------------------------------------------------------------------ +# vec_ptype() + +test_that("ptype is correct", { + expect_identical(vec_ptype(weekday(1:7)), weekday(integer())) +}) From 798a0324eb195047049dd43528715bd3999ffdc7 Mon Sep 17 00:00:00 2001 From: DavisVaughan Date: Fri, 26 Feb 2021 11:36:56 -0500 Subject: [PATCH 10/10] Add vec-ptype method for year-day --- NAMESPACE | 1 + R/gregorian-year-day.R | 36 ++++++++++++++++++++++++ R/zzz.R | 1 + tests/testthat/test-gregorian-year-day.R | 19 +++++++++++++ 4 files changed, 57 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 2567cb60..b0f89ad8 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/gregorian-year-day.R b/R/gregorian-year-day.R index 543cd158..7be78bfd 100644 --- a/R/gregorian-year-day.R +++ b/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) +} diff --git a/R/zzz.R b/R/zzz.R index 31e0fb68..2cf13d5c 100644 --- a/R/zzz.R +++ b/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) diff --git a/tests/testthat/test-gregorian-year-day.R b/tests/testthat/test-gregorian-year-day.R index 00deed3b..615057c8 100644 --- a/tests/testthat/test-gregorian-year-day.R +++ b/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()