library(vctrs)
# ------------------------------------------------------------------------------
# Common ptype2 / cast
test_that("no common type when mixing Period/Duration/Interval", {
verify_errors({
expect_error(vec_ptype2(period(), duration()), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(duration(), period()), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(period(), interval()), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(interval(), period()), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(duration(), interval()), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(interval(), duration()), class = "vctrs_error_incompatible_type")
})
})
test_that("can't cast between Period/Duration/Interval", {
verify_errors({
expect_error(vec_cast(period(), duration()), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(duration(), period()), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(period(), interval()), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(interval(), period()), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(duration(), interval()), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(interval(), duration()), class = "vctrs_error_incompatible_type")
})
})
# ------------------------------------------------------------------------------
# Period - proxy / restore
test_that("proxy is a data frame", {
x <- period(year = 1:2, day = 3:4)
expect <- list(
year = x@year, month = x@month, day = x@day,
hour = x@hour, minute = x@minute, second = x@.Data
)
expect <- new_data_frame(expect)
expect_identical(vec_proxy(x), expect)
})
test_that("proxy stores names on the `$second` column (allowing duplicates)", {
skip_if_cant_set_s4_names()
x <- stats::setNames(days(1:3), c("x", "y", "x"))
proxy <- vec_proxy(x)
expect_named(proxy$second, names(x))
})
test_that("comparison / equality proxies have the names too", {
skip_if_cant_set_s4_names()
x <- stats::setNames(days(1:3), c("x", "y", "x"))
expect_named(vec_proxy_compare(x)$second, names(x))
expect_named(vec_proxy_equal(x)$second, names(x))
})
test_that("restore method works", {
x <- period(year = 1:2, day = 3:4)
expect_identical(vec_restore(vec_proxy(x), x), x)
})
test_that("restore method retains names", {
skip_if_cant_set_s4_names()
x <- stats::setNames(days(1), "x")
expect_named(vec_restore(vec_proxy(x), x), "x")
})
# ------------------------------------------------------------------------------
# Period - ptype2
test_that("Period default ptype2 method falls through to `vec_default_ptype2()`", {
verify_errors({
expect_error(vec_ptype2(period(), 1), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(1, period()), class = "vctrs_error_incompatible_type")
})
})
test_that("common type of Period and Period exists", {
expect_identical(vec_ptype2(period(), period()), period())
})
test_that("common type of Period and NULL exists", {
expect_identical(vec_ptype2(period(), NULL), period())
expect_identical(vec_ptype2(NULL, period()), period())
})
test_that("common type of Period and unspecified exists", {
expect_identical(vec_ptype2(period(), NA), period())
expect_identical(vec_ptype2(NA, period()), period())
expect_identical(vec_ptype2(period(), vctrs::unspecified()), period())
expect_identical(vec_ptype2(vctrs::unspecified(), period()), period())
})
# ------------------------------------------------------------------------------
# Period - cast
test_that("Period default cast method falls through to `vec_default_cast()`", {
verify_errors({
expect_error(vec_cast(period(), 1), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(1, period()), class = "vctrs_error_incompatible_type")
})
})
test_that("Period can be cast to Period", {
expect_identical(vec_cast(days(1), months(1)), days(1))
})
test_that("can cast around `NULL`", {
expect_identical(vec_cast(NULL, period()), NULL)
expect_identical(vec_cast(period(), NULL), period())
})
test_that("can cast unspecified to Period", {
expect_identical(vec_cast(NA, period()), period()[NA_real_])
expect_error(vec_cast(period(), NA), class = "vctrs_error_incompatible_type")
})
# ------------------------------------------------------------------------------
# Period - vctrs functionality
test_that("can slice Period objects", {
expect_identical(vec_slice(days(3:4), 2:1), days(4:3))
})
test_that("slicing preserves names", {
skip_if_cant_set_s4_names()
x <- stats::setNames(days(1:2), c("x", "y"))
expect_named(vec_slice(x, c(1, 1, 2)), c("x", "x", "y"))
})
test_that("can combine Period objects", {
expect_identical(vec_c(days(1), days(2)), days(1:2))
})
test_that("can combine Period objects when some are named (#1072)", {
skip_if_cant_set_s4_names()
x <- days(1)
y <- stats::setNames(days(2), "y")
expect_named(vec_c(x, y), c("", "y"))
})
test_that("can row bind Period objects", {
skip_if_cant_set_s4_names()
x <- stats::setNames(days(1), "x")
expect_identical(vec_rbind(x, x), data.frame(x = c(x, x)))
})
test_that("can row bind data frames with Period objects", {
expect_identical(
vec_rbind(data.frame(x = days(1)), data.frame(x = days(1))),
data.frame(x = days(c(1, 1)))
)
})
test_that("can column bind Period objects", {
expect_identical(
vec_cbind(x = days(1), y = days(1:2)),
data.frame(x = days(c(1, 1)), y = days(1:2))
)
})
test_that("can column bind data frames with Period objects", {
expect_identical(
vec_cbind(data.frame(x = days(1)), data.frame(y = days(1:2))),
data.frame(x = days(c(1, 1)), y = days(1:2))
)
})
test_that("Period objects can be ordered", {
expect_identical(vec_order(vec_c(years(1), days(1))), c(2L, 1L))
expect_identical(vec_order(vec_c(days(2), days(1))), c(2L, 1L))
})
# ------------------------------------------------------------------------------
# Duration - proxy / restore
test_that("proxy is the underlying number of seconds", {
x <- ddays(1:2)
expect_identical(vec_proxy(x), x@.Data)
})
test_that("proxy stores the names", {
skip_if_cant_set_s4_names()
x <- stats::setNames(ddays(1:3), c("x", "y", "x"))
expect_named(vec_proxy(x), c("x", "y", "x"))
})
test_that("comparison / equality proxies store names too", {
skip_if_cant_set_s4_names()
x <- stats::setNames(ddays(1:3), c("x", "y", "x"))
expect_named(vec_proxy_compare(x), names(x))
expect_named(vec_proxy_equal(x), names(x))
})
test_that("restore method works", {
x <- ddays(1:2)
expect_identical(vec_restore(vec_proxy(x), x), x)
})
test_that("restore method retains names", {
skip_if_cant_set_s4_names()
x <- stats::setNames(ddays(1), "x")
expect_named(vec_restore(vec_proxy(x), x), "x")
})
# ------------------------------------------------------------------------------
# Duration - ptype2
test_that("Duration default ptype2 method falls through to `vec_default_ptype2()`", {
verify_errors({
expect_error(vec_ptype2(duration(), 1), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(1, duration()), class = "vctrs_error_incompatible_type")
})
})
test_that("common type of Duration and Duration exists", {
expect_identical(vec_ptype2(duration(), duration()), duration())
})
test_that("common type of Duration and NULL exists", {
expect_identical(vec_ptype2(duration(), NULL), duration())
expect_identical(vec_ptype2(NULL, duration()), duration())
})
test_that("common type of Duration and unspecified exists", {
expect_identical(vec_ptype2(duration(), NA), duration())
expect_identical(vec_ptype2(NA, duration()), duration())
expect_identical(vec_ptype2(duration(), unspecified()), duration())
expect_identical(vec_ptype2(unspecified(), duration()), duration())
})
test_that("common type of Duration and difftime is Duration", {
expect_identical(vec_ptype2(duration(), new_duration()), duration())
expect_identical(vec_ptype2(new_duration(), duration()), duration())
})
# ------------------------------------------------------------------------------
# Duration - cast
test_that("Duration default cast method falls through to `vec_default_cast()`", {
verify_errors({
expect_error(vec_cast(duration(), 1), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(1, duration()), class = "vctrs_error_incompatible_type")
})
})
test_that("Duration can be cast to Duration", {
expect_identical(vec_cast(ddays(1), dmonths(1)), ddays(1))
})
test_that("can cast around `NULL`", {
expect_identical(vec_cast(NULL, duration()), NULL)
expect_identical(vec_cast(duration(), NULL), duration())
})
test_that("can cast unspecified to Duration", {
expect_identical(vec_cast(NA, duration()), duration()[NA_real_])
expect_error(vec_cast(duration(), NA), class = "vctrs_error_incompatible_type")
})
test_that("Duration can be cast to and from difftime", {
expect_identical(vec_cast(duration(), new_duration()), new_duration())
expect_identical(vec_cast(new_duration(), duration()), duration())
})
# ------------------------------------------------------------------------------
# Duration - vctrs functionality
test_that("can slice Duration objects", {
expect_identical(vec_slice(ddays(3:4), 2:1), ddays(4:3))
})
test_that("slicing preserves names", {
skip_if_cant_set_s4_names()
x <- stats::setNames(ddays(1:2), c("x", "y"))
expect_named(vec_slice(x, c(1, 1, 2)), c("x", "x", "y"))
})
test_that("can combine Duration objects", {
expect_identical(vec_c(ddays(1), ddays(2)), ddays(1:2))
})
test_that("can combine Duration objects when some are named (#1072)", {
skip_if_cant_set_s4_names()
x <- ddays(1)
y <- stats::setNames(ddays(2), "y")
expect_named(vec_c(x, y), c("", "y"))
})
test_that("can row bind Duration objects", {
skip_if_cant_set_s4_names()
x <- ddays(1)
x_named <- stats::setNames(x, "x")
expect_identical(vec_rbind(x_named, x_named), data.frame(x = c(x, x)))
})
test_that("can row bind data frames with Duration objects", {
expect_identical(
vec_rbind(data.frame(x = ddays(1)), data.frame(x = ddays(1))),
data.frame(x = ddays(c(1, 1)))
)
})
test_that("can column bind Duration objects", {
expect_identical(
vec_cbind(x = ddays(1), y = ddays(1:2)),
data.frame(x = ddays(c(1, 1)), y = ddays(1:2))
)
})
test_that("can column bind data frames with Duration objects", {
expect_identical(
vec_cbind(data.frame(x = ddays(1)), data.frame(y = ddays(1:2))),
data.frame(x = ddays(c(1, 1)), y = ddays(1:2))
)
})
# ------------------------------------------------------------------------------
# Interval - proxy / restore
test_that("proxy is a data frame", {
x <- interval(tzone = "UTC")
expect <- list(start = POSIXct(tz = "UTC"), span = numeric())
expect <- new_data_frame(expect)
expect_identical(vec_proxy(x), expect)
})
test_that("proxy stores names on the `$span` column (allowing duplicates)", {
skip_if_cant_set_s4_names()
x <- c("2019-01-01", "2019-01-02", "2019-01-03")
x <- stats::setNames(interval(x), c("x", "y", "x"))
proxy <- vec_proxy(x)
expect_named(proxy$span, names(x))
})
test_that("comparison / equality proxies have the names too", {
skip_if_cant_set_s4_names()
x <- c("2019-01-01", "2019-01-02", "2019-01-03")
x <- stats::setNames(interval(x), c("x", "y", "x"))
expect_named(vec_proxy_compare(x)$span, names(x))
expect_named(vec_proxy_equal(x)$span, names(x))
})
test_that("restore method works", {
x <- interval(c("2019-01-01", "2019-01-02"), c("2020-01-01", "2020-01-02"))
expect_identical(vec_restore(vec_proxy(x), x), x)
})
test_that("restore method retains names", {
skip_if_cant_set_s4_names()
x <- stats::setNames(interval("2019-01-01"), "x")
expect_named(vec_restore(vec_proxy(x), x), "x")
})
# ------------------------------------------------------------------------------
# Interval - ptype2
test_that("Interval default ptype2 method falls through to `vec_default_ptype2()`", {
verify_errors({
expect_error(vec_ptype2(interval(), 1), class = "vctrs_error_incompatible_type")
expect_error(vec_ptype2(1, interval()), class = "vctrs_error_incompatible_type")
})
})
test_that("common type of Interval and Interval exists", {
expect_identical(vec_ptype2(interval(), interval()), interval())
x <- interval(tzone = "America/Los_Angeles")
expect_identical(vec_ptype2(x, x), x)
})
test_that("common tzone uses non-local tzone", {
x <- interval(tzone = "")
y <- interval(tzone = "America/Los_Angeles")
expect_identical(vec_ptype2(x, y)@tzone, "America/Los_Angeles")
expect_identical(vec_ptype2(y, x)@tzone, "America/Los_Angeles")
expect_identical(tz(int_start(vec_ptype2(x, y))), "America/Los_Angeles")
expect_identical(tz(int_start(vec_ptype2(y, x))), "America/Los_Angeles")
})
test_that("common tzone is order dependent", {
x <- interval(tzone = "America/New_York")
y <- interval(tzone = "America/Los_Angeles")
expect_identical(vec_ptype2(x, y)@tzone, "America/New_York")
expect_identical(vec_ptype2(y, x)@tzone, "America/Los_Angeles")
expect_identical(tz(int_start(vec_ptype2(x, y))), "America/New_York")
expect_identical(tz(int_start(vec_ptype2(y, x))), "America/Los_Angeles")
})
test_that("common type of Interval and NULL exists", {
expect_identical(vec_ptype2(interval(), NULL), interval())
expect_identical(vec_ptype2(NULL, interval()), interval())
})
test_that("common type of Interval and unspecified exists", {
expect_identical(vec_ptype2(interval(), NA), interval())
expect_identical(vec_ptype2(NA, interval()), interval())
expect_identical(vec_ptype2(interval(), unspecified()), interval())
expect_identical(vec_ptype2(unspecified(), interval()), interval())
})
# ------------------------------------------------------------------------------
# Interval - cast
test_that("Interval default cast method falls through to `vec_default_cast()`", {
verify_errors({
expect_error(vec_cast(interval(), 1), class = "vctrs_error_incompatible_type")
expect_error(vec_cast(1, interval()), class = "vctrs_error_incompatible_type")
})
})
test_that("Interval can be cast to Interval", {
expect_identical(vec_cast(interval(), interval()), interval())
})
test_that("can cast to a different tzone", {
x_tzone <- "America/Los_Angeles"
x_start <- as.POSIXct("1970-01-01", tz = x_tzone)
x_end <- as.POSIXct("1970-01-02", tz = x_tzone)
x <- interval(x_start, x_end, x_tzone)
to_tzone <- "America/New_York"
to <- interval(tzone = to_tzone)
expect_start <- with_tz(x_start, to_tzone)
expect_end <- with_tz(x_end, to_tzone)
expect <- interval(expect_start, expect_end, to_tzone)
expect_identical(vec_cast(x, to), expect)
})
test_that("can cast around `NULL`", {
expect_identical(vec_cast(NULL, interval()), NULL)
expect_identical(vec_cast(interval(), NULL), interval())
})
test_that("can cast unspecified to Interval", {
expect_identical(vec_cast(NA, interval()), interval()[NA_real_])
expect_error(vec_cast(interval(), NA), class = "vctrs_error_incompatible_type")
})
# ------------------------------------------------------------------------------
# Interval - vctrs functionality
test_that("can slice Interval objects", {
x <- interval(c("1970-01-01", "1970-01-02"))
expect_identical(vec_slice(x, 2:1), x[2:1])
})
test_that("slicing preserves names", {
skip_if_cant_set_s4_names()
x <- interval(c("1970-01-01", "1970-01-02"))
x <- stats::setNames(x, c("x", "y"))
expect_named(vec_slice(x, c(1, 1, 2)), c("x", "x", "y"))
})
test_that("can combine Interval objects", {
x <- interval("1970-01-01")
y <- interval("1970-01-02")
expect <- interval(c("1970-01-01", "1970-01-02"))
expect_identical(vec_c(x, y), expect)
})
test_that("can combine Interval objects when some are named (#1072)", {
skip_if_cant_set_s4_names()
x <- interval("1970-01-01")
y <- stats::setNames(interval("1970-01-02"), "y")
expect_named(vec_c(x, y), c("", "y"))
})
test_that("can row bind Interval objects", {
skip_if_cant_set_s4_names()
x <- interval("1970-01-01")
x_named <- stats::setNames(x, "x")
expect_identical(vec_rbind(x_named, x_named), data.frame(x = c(x, x)))
})
test_that("can row bind data frames with Interval objects", {
x <- interval("1970-01-01")
expect_identical(
vec_rbind(data.frame(x = x), data.frame(x = x)),
data.frame(x = vec_c(x, x))
)
})
test_that("can column bind Interval objects", {
x <- interval("1970-01-01")
y <- interval(c("1970-01-01", "1970-01-02"))
expect_identical(
vec_cbind(x = x, y = y),
data.frame(x = vec_c(x, x), y = y)
)
})
test_that("can column bind data frames with Interval objects", {
x <- interval("1970-01-01")
y <- interval(c("1970-01-01", "1970-01-02"))
expect_identical(
vec_cbind(data.frame(x = x), data.frame(y = y)),
data.frame(x = vec_c(x, x), y = y)
)
})
test_that("Interval objects can be ordered", {
x <- interval("1970-01-01", "1970-01-02")
y <- interval("1970-01-02", "1970-01-03")
z <- interval("1970-01-02", "1970-01-04")
# Different from `order()`!
expect_identical(vec_order(vec_c(y, x)), c(2L, 1L))
expect_identical(vec_order(vec_c(z, y)), c(2L, 1L))
})
# ------------------------------------------------------------------------------
# Output
test_that("vctrs methods have informative errors", {
# partial match warning from [<-.data.frame messes up snapshots
skip_if_not(getRversion() >= "3.6.0")
expect_snapshot(error = TRUE, {
"# no common type when mixing Period/Duration/Interval"
vec_ptype2(period(), duration())
vec_ptype2(duration(), period())
vec_ptype2(period(), interval())
vec_ptype2(interval(), period())
vec_ptype2(duration(), interval())
vec_ptype2(interval(), duration())
"# can't cast between Period/Duration/Interval"
vec_cast(period(), duration())
vec_cast(duration(), period())
vec_cast(period(), interval())
vec_cast(interval(), period())
vec_cast(duration(), interval())
vec_cast(interval(), duration())
"# Period default ptype2 method falls through to `vec_default_ptype2()`"
vec_ptype2(period(), 1)
vec_ptype2(1, period())
"# Period default cast method falls through to `vec_default_cast()`"
vec_cast(period(), 1)
vec_cast(1, period())
"# Duration default ptype2 method falls through to `vec_default_ptype2()`"
vec_ptype2(duration(), 1)
vec_ptype2(1, duration())
"# Duration default cast method falls through to `vec_default_cast()`"
vec_cast(duration(), 1)
vec_cast(1, duration())
"# Interval default ptype2 method falls through to `vec_default_ptype2()`"
vec_ptype2(interval(), 1)
vec_ptype2(1, interval())
"# Interval default cast method falls through to `vec_default_cast()`"
vec_cast(interval(), 1)
vec_cast(1, interval())
})
})
Generated by dwww version 1.15 on Tue Jul 2 09:05:04 CEST 2024.