test_that("inputs must be vectors", {
expect_error(vec_compare(NULL, 1), class = "vctrs_error_scalar_type")
expect_error(vec_compare(1, NULL), class = "vctrs_error_scalar_type")
})
test_that("matches R ordering", {
expect_same <- function(x, y) {
expect_equal(vec_compare(!!x, !!y), cmp(!!x, !!y))
}
expect_same(c(NA, FALSE, TRUE), FALSE)
expect_same(c(NA, -100L, 0L, 100L), 0L)
expect_same(c(NA, -Inf, -100, 100, Inf), 0L)
expect_same(c(NA, NaN, 0), NA)
expect_same(c(NA, "a", "b", "c"), "b")
expect_same(as.raw(2:5), as.raw(4))
})
test_that("NAs equal when requested", {
expect_value <- function(x, y, val, .ptype = NULL) {
expect_equal(vec_compare(!!x, !!y, .ptype = .ptype, na_equal = TRUE), !!val)
}
expect_value(NA, NA, 0L)
expect_value(NA, FALSE, -1L)
expect_value(FALSE, NA, 1L)
expect_value(NA_integer_, NA_integer_, 0L)
expect_value(NA_integer_, 0L, -1L)
expect_value(0L, NA_integer_, 1L)
expect_value(NA_character_, NA_character_, 0L)
expect_value(NA_character_, "", -1L)
expect_value("", NA_character_, 1L)
expect_value(0, NA_real_, 1L)
expect_value(0, NaN, 1L)
expect_value(0, 0, 0L)
expect_value(NA_real_, NA_real_, 0L)
expect_value(NA_real_, NaN, 1L)
expect_value(NA_real_, 0, -1L)
expect_value(NaN, NA_real_, -1L)
expect_value(NaN, NaN, 0L)
expect_value(NaN, 0, -1L)
})
test_that("data frames are compared column by column", {
df1 <- data.frame(x = c(1, 1, 1), y = c(-1, 0, 1))
expect_equal(vec_compare(df1, df1[2, ]), c(-1, 0, 1))
expect_equal(vec_compare(df1[1], df1[2, 1, drop = FALSE]), c(0, 0, 0))
expect_equal(vec_compare(df1[2], df1[2, 2, drop = FALSE]), c(-1, 0, 1))
expect_equal(vec_compare(df1[2:1], df1[2, 2:1]), c(-1, 0, 1))
})
test_that("can compare data frames with various types of columns", {
x1 <- data_frame(x = 1, y = 2)
y1 <- data_frame(x = 2, y = 1)
x2 <- data_frame(x = "a")
y2 <- data_frame(x = "b")
x3 <- data_frame(x = FALSE)
y3 <- data_frame(x = TRUE)
x4 <- data_frame(x = 1L)
y4 <- data_frame(x = 2L)
expect_equal(vec_compare(x1, y1), -1)
expect_equal(vec_compare(x2, y2), -1)
expect_equal(vec_compare(x3, y3), -1)
expect_equal(vec_compare(x4, y4), -1)
})
test_that("can compare data frames with data frame columns", {
df1 <- data_frame(x = data_frame(a = 1))
df2 <- data_frame(x = data_frame(a = 2))
expect_equal(vec_compare(df1, df1), 0)
expect_equal(vec_compare(df1, df2), -1)
})
test_that("can compare data frames with 0 columns", {
x <- new_data_frame(n = 2L)
expect_identical(vec_compare(x, x), c(0L, 0L))
})
test_that("C code doesn't crash with bad inputs", {
df <- data.frame(x = c(1, 1, 1), y = c(-1, 0, 1))
expect_error(.Call(ffi_vec_compare, df, df[1], TRUE), "not comparable")
# Names are not checked, as `vec_cast_common()` should take care of the type.
# So if `vec_cast_common()` is not called, or is improperly specified, then
# this could result in false equality.
expect_equal(.Call(ffi_vec_compare, df, setNames(df, c("x", "z")), TRUE), c(0, 0, 0))
df1 <- new_data_frame(list(x = 1:3, y = c(1, 1, 1)))
df2 <- new_data_frame(list(y = 1:2, x = 1:2))
expect_error(.Call(ffi_vec_compare, df1, df2, TRUE), "must have the same types and lengths")
})
test_that("xtfrm.vctrs_vctr works for variety of base classes", {
df <- data.frame(x = c(NA, 1, 1), y = c(1, 2, 1))
# Internally uses `vec_rank()`, which propagates rows if not "complete"
expect_equal(xtfrm.vctrs_vctr(df), c(NA, 2, 1))
x <- c(2, 3, 1)
expect_equal(xtfrm.vctrs_vctr(x), x)
expect_equal(xtfrm.vctrs_vctr(letters[x]), x)
})
test_that("vec_proxy_order() orders list using order of appearance", {
x <- 1:2
y <- 2:4
z <- "a"
lst <- list(x, y, x, y, z)
expect_identical(vec_proxy_order(lst), c(1L, 2L, 1L, 2L, 5L))
})
test_that("vec_compare() calls vec_proxy_compare()", {
local_methods(
vec_proxy_compare.vctrs_foobar = function(x, ...) rev(x),
vec_ptype2.integer.vctrs_foobar = function(...) foobar(int()),
vec_ptype2.vctrs_foobar = function(...) foobar(int()),
vec_cast.vctrs_foobar = function(...) NULL,
vec_cast.vctrs_foobar.integer = function(x, ...) x,
)
expect_identical(vec_compare(1:3, 1:3), int(0, 0, 0))
expect_identical(vec_compare(1:3, foobar(1:3)), int(-1, 0, 1))
})
test_that("vec_proxy_compare() preserves data frames and vectors", {
df <- data_frame(x = 1:2, y = c("a", "b"))
expect_identical(vec_proxy_compare(df), df)
x <- c(NA, "a", "b", "c")
expect_identical(vec_proxy_compare(x), x)
})
test_that("vec_proxy_compare() handles data frame with a POSIXlt column", {
df <- data.frame(times = 1:5, x = 1:5)
df$times <- as.POSIXlt(seq.Date(as.Date("2019-12-30"), as.Date("2020-01-03"), by = "day"))
df2 <- df
df2$times <- vec_proxy_compare(df$times)
expect_identical(
vec_proxy_compare(df),
vec_proxy_compare(df2)
)
})
test_that("vec_proxy_compare.POSIXlt() correctly orders (#720)", {
dates <- as.POSIXlt(seq.Date(as.Date("2019-12-30"), as.Date("2020-01-03"), by = "day"))
expect_equal(vec_order(dates), 1:5)
})
test_that("vec_proxy_compare.POSIXlt() correctly orders around DST", {
# 1am in EDT
x <- as.POSIXlt("2020-11-01 01:00:00", tz = "America/New_York")
# "falls back" to 1am again, but in EST
y <- as.POSIXlt(x + 3600)
expect_equal(vec_order(c(y, x)), c(2, 1))
})
test_that("vec_proxy_compare() flattens df-cols", {
df_col <- data_frame(z = 3:4, w = 4:5)
df <- data_frame(x = 1:2, y = df_col)
expect <- data_frame(x = 1:2, z = 3:4, w = 4:5)
expect_identical(vec_proxy_compare(df), expect)
})
test_that("vec_proxy_compare() unwraps 1 col dfs", {
df <- data_frame(x = 1:2)
expect_identical(vec_proxy_compare(df), 1:2)
df_col <- data_frame(y = 1:2)
df <- data_frame(x = df_col)
expect_identical(vec_proxy_compare(df), 1:2)
})
test_that("vec_proxy_order() works on deeply nested lists", {
df_col <- data_frame(z = list("b", "a", "b"))
# Relaxed and unwrapped
df1 <- data_frame(x = df_col)
expect_identical(vec_proxy_order(df1), c(1L, 2L, 1L))
df2 <- data_frame(x = df_col, y = 1:3)
expect_identical(vec_proxy_order(df2), data_frame(x = c(1L, 2L, 1L), y = 1:3))
})
test_that("error is thrown when comparing complexes (#1655)", {
expect_snapshot({
(expect_error(vec_compare(complex(), complex())))
})
})
test_that("error is thrown when comparing lists", {
expect_error(vec_compare(list(), list()), class = "vctrs_error_unsupported")
expect_error(.Call(ffi_vec_compare, list(), list(), FALSE), "Can't compare lists")
})
test_that("error is thrown when comparing data frames with list columns", {
df <- data_frame(x = list())
expect_error(vec_compare(df, df), class = "vctrs_error_unsupported")
expect_error(.Call(ffi_vec_compare, df, df, FALSE), "Can't compare lists")
})
test_that("error is thrown when comparing scalars", {
x <- new_sclr(x = 1)
expect_error(vec_compare(x, x), class = "vctrs_error_scalar_type")
expect_error(.Call(ffi_vec_compare, x, x, FALSE), class = "vctrs_error_scalar_type")
})
test_that("`na_equal` is validated", {
expect_error(vec_compare(1, 1, na_equal = 1), class = "vctrs_error_assert_ptype")
expect_error(vec_compare(1, 1, na_equal = c(TRUE, FALSE)), class = "vctrs_error_assert_size")
})
test_that("can compare equal strings with different encodings", {
for (x_encoding in encodings()) {
for (y_encoding in encodings()) {
expect_equal(vec_compare(x_encoding, y_encoding), 0L)
}
}
})
test_that("can compare non-equal strings with different encodings", {
x <- "x"
y <- encodings()$latin1
expect_equal(vec_compare(x, y), -1L)
})
test_that("comparison can be determined when strings have identical encodings", {
encs <- encodings()
for (enc in encs) {
expect_equal(vec_compare(enc, enc), 0L)
}
})
test_that("comparison is known to always fail with bytes", {
enc <- encoding_bytes()
error <- "translating strings with \"bytes\" encoding"
expect_error(vec_compare(enc, enc), error)
})
test_that("comparison is known to fail when comparing bytes to other encodings", {
error <- "translating strings with \"bytes\" encoding"
for (enc in encodings()) {
expect_error(vec_compare(encoding_bytes(), enc), error)
expect_error(vec_compare(enc, encoding_bytes()), error)
}
})
test_that("can compare unspecified", {
expect_equal(vec_compare(NA, NA), NA_integer_)
expect_equal(vec_compare(NA, NA, na_equal = TRUE), 0)
expect_equal(vec_compare(c(NA, NA), unspecified(2)), c(NA_integer_, NA_integer_))
})
test_that("can't supply NA as `na_equal`", {
expect_error(vec_compare(NA, NA, na_equal = NA), "single `TRUE` or `FALSE`")
})
test_that("vec_compare() silently falls back to base data frame", {
expect_silent(expect_identical(
vec_compare(foobar(mtcars), foobar(tibble::as_tibble(mtcars))),
rep(0L, 32)
))
})
Generated by dwww version 1.15 on Sat May 18 09:39:08 CEST 2024.