1context("vctrs") 2 3library(vctrs) 4 5# ------------------------------------------------------------------------------ 6# Common ptype2 / cast 7 8test_that("no common type when mixing Period/Duration/Interval", { 9 verify_errors({ 10 expect_error(vec_ptype2(period(), duration()), class = "vctrs_error_incompatible_type") 11 expect_error(vec_ptype2(duration(), period()), class = "vctrs_error_incompatible_type") 12 13 expect_error(vec_ptype2(period(), interval()), class = "vctrs_error_incompatible_type") 14 expect_error(vec_ptype2(interval(), period()), class = "vctrs_error_incompatible_type") 15 16 expect_error(vec_ptype2(duration(), interval()), class = "vctrs_error_incompatible_type") 17 expect_error(vec_ptype2(interval(), duration()), class = "vctrs_error_incompatible_type") 18 }) 19}) 20 21test_that("can't cast between Period/Duration/Interval", { 22 verify_errors({ 23 expect_error(vec_cast(period(), duration()), class = "vctrs_error_incompatible_type") 24 expect_error(vec_cast(duration(), period()), class = "vctrs_error_incompatible_type") 25 26 expect_error(vec_cast(period(), interval()), class = "vctrs_error_incompatible_type") 27 expect_error(vec_cast(interval(), period()), class = "vctrs_error_incompatible_type") 28 29 expect_error(vec_cast(duration(), interval()), class = "vctrs_error_incompatible_type") 30 expect_error(vec_cast(interval(), duration()), class = "vctrs_error_incompatible_type") 31 }) 32}) 33 34# ------------------------------------------------------------------------------ 35# Period - proxy / restore 36 37test_that("proxy is a data frame", { 38 x <- period(year = 1:2, day = 3:4) 39 40 expect <- list( 41 year = x@year, month = x@month, day = x@day, 42 hour = x@hour, minute = x@minute, second = x@.Data 43 ) 44 45 expect <- new_data_frame(expect) 46 47 expect_identical(vec_proxy(x), expect) 48}) 49 50test_that("proxy can optionally store vector names in the last column (allowing duplicates)", { 51 skip_if_cant_set_s4_names() 52 53 x <- stats::setNames(days(1:3), c("x", "y", "x")) 54 55 proxy <- vec_proxy(x) 56 57 expect_identical(proxy$rcrd_names, names(x)) 58 expect_identical(match("rcrd_names", names(proxy)), ncol(proxy)) 59}) 60 61test_that("comparison / equality proxies don't have the names column", { 62 skip_if_cant_set_s4_names() 63 64 x <- stats::setNames(days(1:3), c("x", "y", "x")) 65 66 expect_null(vec_proxy_compare(x)$rcrd_names) 67 expect_null(vec_proxy_equal(x)$rcrd_names) 68}) 69 70test_that("restore method works", { 71 x <- period(year = 1:2, day = 3:4) 72 expect_identical(vec_restore(vec_proxy(x), x), x) 73}) 74 75test_that("restore method retains names", { 76 skip_if_cant_set_s4_names() 77 x <- stats::setNames(days(1), "x") 78 expect_named(vec_restore(vec_proxy(x), x), "x") 79}) 80 81# ------------------------------------------------------------------------------ 82# Period - ptype2 83 84test_that("Period default ptype2 method falls through to `vec_default_ptype2()`", { 85 verify_errors({ 86 expect_error(vec_ptype2(period(), 1), class = "vctrs_error_incompatible_type") 87 expect_error(vec_ptype2(1, period()), class = "vctrs_error_incompatible_type") 88 }) 89}) 90 91test_that("common type of Period and Period exists", { 92 expect_identical(vec_ptype2(period(), period()), period()) 93}) 94 95test_that("common type of Period and NULL exists", { 96 expect_identical(vec_ptype2(period(), NULL), period()) 97 expect_identical(vec_ptype2(NULL, period()), period()) 98}) 99 100test_that("common type of Period and unspecified exists", { 101 expect_identical(vec_ptype2(period(), NA), period()) 102 expect_identical(vec_ptype2(NA, period()), period()) 103 104 expect_identical(vec_ptype2(period(), vctrs::unspecified()), period()) 105 expect_identical(vec_ptype2(vctrs::unspecified(), period()), period()) 106}) 107 108# ------------------------------------------------------------------------------ 109# Period - cast 110 111test_that("Period default cast method falls through to `vec_default_cast()`", { 112 verify_errors({ 113 expect_error(vec_cast(period(), 1), class = "vctrs_error_incompatible_type") 114 expect_error(vec_cast(1, period()), class = "vctrs_error_incompatible_type") 115 }) 116}) 117 118test_that("Period can be cast to Period", { 119 expect_identical(vec_cast(days(1), months(1)), days(1)) 120}) 121 122test_that("can cast around `NULL`", { 123 expect_identical(vec_cast(NULL, period()), NULL) 124 expect_identical(vec_cast(period(), NULL), period()) 125}) 126 127test_that("can cast unspecified to Period", { 128 expect_identical(vec_cast(NA, period()), period()[NA_real_]) 129 expect_error(vec_cast(period(), NA), class = "vctrs_error_incompatible_type") 130}) 131 132# ------------------------------------------------------------------------------ 133# Period - vctrs functionality 134 135test_that("can slice Period objects", { 136 expect_identical(vec_slice(days(3:4), 2:1), days(4:3)) 137}) 138 139test_that("slicing preserves names", { 140 skip_if_cant_set_s4_names() 141 x <- stats::setNames(days(1:2), c("x", "y")) 142 expect_named(vec_slice(x, c(1, 1, 2)), c("x", "x", "y")) 143}) 144 145test_that("can combine Period objects", { 146 expect_identical(vec_c(days(1), days(2)), days(1:2)) 147}) 148 149test_that("can row bind Period objects", { 150 skip_if_cant_set_s4_names() 151 x <- stats::setNames(days(1), "x") 152 expect_identical(vec_rbind(x, x), data.frame(x = c(x, x))) 153}) 154 155test_that("can row bind data frames with Period objects", { 156 expect_identical( 157 vec_rbind(data.frame(x = days(1)), data.frame(x = days(1))), 158 data.frame(x = days(c(1, 1))) 159 ) 160}) 161 162test_that("can column bind Period objects", { 163 expect_identical( 164 vec_cbind(x = days(1), y = days(1:2)), 165 data.frame(x = days(c(1, 1)), y = days(1:2)) 166 ) 167}) 168 169test_that("can column bind data frames with Period objects", { 170 expect_identical( 171 vec_cbind(data.frame(x = days(1)), data.frame(y = days(1:2))), 172 data.frame(x = days(c(1, 1)), y = days(1:2)) 173 ) 174}) 175 176test_that("Period objects can be ordered", { 177 expect_identical(vec_order(vec_c(years(1), days(1))), c(2L, 1L)) 178 expect_identical(vec_order(vec_c(days(2), days(1))), c(2L, 1L)) 179}) 180 181# ------------------------------------------------------------------------------ 182# Duration - proxy / restore 183 184test_that("proxy is the underlying number of seconds", { 185 x <- ddays(1:2) 186 expect_identical(vec_proxy(x), x@.Data) 187}) 188 189test_that("proxy stores the names", { 190 skip_if_cant_set_s4_names() 191 x <- stats::setNames(ddays(1:3), c("x", "y", "x")) 192 expect_named(vec_proxy(x), c("x", "y", "x")) 193}) 194 195test_that("comparison / equality proxies don't store names", { 196 skip_if_cant_set_s4_names() 197 x <- stats::setNames(ddays(1:3), c("x", "y", "x")) 198 expect_named(vec_proxy_compare(x), NULL) 199 expect_named(vec_proxy_equal(x), NULL) 200}) 201 202test_that("restore method works", { 203 x <- ddays(1:2) 204 expect_identical(vec_restore(vec_proxy(x), x), x) 205}) 206 207test_that("restore method retains names", { 208 skip_if_cant_set_s4_names() 209 x <- stats::setNames(ddays(1), "x") 210 expect_named(vec_restore(vec_proxy(x), x), "x") 211}) 212 213# ------------------------------------------------------------------------------ 214# Duration - ptype2 215 216test_that("Duration default ptype2 method falls through to `vec_default_ptype2()`", { 217 verify_errors({ 218 expect_error(vec_ptype2(duration(), 1), class = "vctrs_error_incompatible_type") 219 expect_error(vec_ptype2(1, duration()), class = "vctrs_error_incompatible_type") 220 }) 221}) 222 223test_that("common type of Duration and Duration exists", { 224 expect_identical(vec_ptype2(duration(), duration()), duration()) 225}) 226 227test_that("common type of Duration and NULL exists", { 228 expect_identical(vec_ptype2(duration(), NULL), duration()) 229 expect_identical(vec_ptype2(NULL, duration()), duration()) 230}) 231 232test_that("common type of Duration and unspecified exists", { 233 expect_identical(vec_ptype2(duration(), NA), duration()) 234 expect_identical(vec_ptype2(NA, duration()), duration()) 235 236 expect_identical(vec_ptype2(duration(), unspecified()), duration()) 237 expect_identical(vec_ptype2(unspecified(), duration()), duration()) 238}) 239 240test_that("common type of Duration and difftime is Duration", { 241 expect_identical(vec_ptype2(duration(), new_duration()), duration()) 242 expect_identical(vec_ptype2(new_duration(), duration()), duration()) 243}) 244 245# ------------------------------------------------------------------------------ 246# Duration - cast 247 248test_that("Duration default cast method falls through to `vec_default_cast()`", { 249 verify_errors({ 250 expect_error(vec_cast(duration(), 1), class = "vctrs_error_incompatible_type") 251 expect_error(vec_cast(1, duration()), class = "vctrs_error_incompatible_type") 252 }) 253}) 254 255test_that("Duration can be cast to Duration", { 256 expect_identical(vec_cast(ddays(1), dmonths(1)), ddays(1)) 257}) 258 259test_that("can cast around `NULL`", { 260 expect_identical(vec_cast(NULL, duration()), NULL) 261 expect_identical(vec_cast(duration(), NULL), duration()) 262}) 263 264test_that("can cast unspecified to Duration", { 265 expect_identical(vec_cast(NA, duration()), duration()[NA_real_]) 266 expect_error(vec_cast(duration(), NA), class = "vctrs_error_incompatible_type") 267}) 268 269test_that("Duration can be cast to and from difftime", { 270 expect_identical(vec_cast(duration(), new_duration()), new_duration()) 271 expect_identical(vec_cast(new_duration(), duration()), duration()) 272}) 273 274# ------------------------------------------------------------------------------ 275# Duration - vctrs functionality 276 277test_that("can slice Duration objects", { 278 expect_identical(vec_slice(ddays(3:4), 2:1), ddays(4:3)) 279}) 280 281test_that("slicing preserves names", { 282 skip_if_cant_set_s4_names() 283 x <- stats::setNames(ddays(1:2), c("x", "y")) 284 expect_named(vec_slice(x, c(1, 1, 2)), c("x", "x", "y")) 285}) 286 287test_that("can combine Duration objects", { 288 expect_identical(vec_c(ddays(1), ddays(2)), ddays(1:2)) 289}) 290 291test_that("can row bind Duration objects", { 292 skip_if_cant_set_s4_names() 293 x <- ddays(1) 294 x_named <- stats::setNames(x, "x") 295 expect_identical(vec_rbind(x_named, x_named), data.frame(x = c(x, x))) 296}) 297 298test_that("can row bind data frames with Duration objects", { 299 expect_identical( 300 vec_rbind(data.frame(x = ddays(1)), data.frame(x = ddays(1))), 301 data.frame(x = ddays(c(1, 1))) 302 ) 303}) 304 305test_that("can column bind Duration objects", { 306 expect_identical( 307 vec_cbind(x = ddays(1), y = ddays(1:2)), 308 data.frame(x = ddays(c(1, 1)), y = ddays(1:2)) 309 ) 310}) 311 312test_that("can column bind data frames with Duration objects", { 313 expect_identical( 314 vec_cbind(data.frame(x = ddays(1)), data.frame(y = ddays(1:2))), 315 data.frame(x = ddays(c(1, 1)), y = ddays(1:2)) 316 ) 317}) 318 319# ------------------------------------------------------------------------------ 320# Interval - proxy / restore 321 322test_that("proxy is a data frame", { 323 x <- interval(tzone = "UTC") 324 325 expect <- list(start = POSIXct(tz = "UTC"), span = numeric()) 326 expect <- new_data_frame(expect) 327 328 expect_identical(vec_proxy(x), expect) 329}) 330 331test_that("proxy can optionally store vector names in the last column (allowing duplicates)", { 332 skip_if_cant_set_s4_names() 333 334 x <- c("2019-01-01", "2019-01-02", "2019-01-03") 335 x <- stats::setNames(interval(x), c("x", "y", "x")) 336 337 proxy <- vec_proxy(x) 338 339 expect_identical(proxy$rcrd_names, names(x)) 340 expect_identical(match("rcrd_names", names(proxy)), ncol(proxy)) 341}) 342 343test_that("comparison / equality proxies don't have the names column", { 344 skip_if_cant_set_s4_names() 345 346 x <- c("2019-01-01", "2019-01-02", "2019-01-03") 347 x <- stats::setNames(interval(x), c("x", "y", "x")) 348 349 expect_null(vec_proxy_compare(x)$rcrd_names) 350 expect_null(vec_proxy_equal(x)$rcrd_names) 351}) 352 353test_that("restore method works", { 354 x <- interval(c("2019-01-01", "2019-01-02"), c("2020-01-01", "2020-01-02")) 355 expect_identical(vec_restore(vec_proxy(x), x), x) 356}) 357 358test_that("restore method retains names", { 359 skip_if_cant_set_s4_names() 360 x <- stats::setNames(interval("2019-01-01"), "x") 361 expect_named(vec_restore(vec_proxy(x), x), "x") 362}) 363 364# ------------------------------------------------------------------------------ 365# Interval - ptype2 366 367test_that("Interval default ptype2 method falls through to `vec_default_ptype2()`", { 368 verify_errors({ 369 expect_error(vec_ptype2(interval(), 1), class = "vctrs_error_incompatible_type") 370 expect_error(vec_ptype2(1, interval()), class = "vctrs_error_incompatible_type") 371 }) 372}) 373 374test_that("common type of Interval and Interval exists", { 375 expect_identical(vec_ptype2(interval(), interval()), interval()) 376 377 x <- interval(tzone = "America/Los_Angeles") 378 expect_identical(vec_ptype2(x, x), x) 379}) 380 381test_that("common tzone uses non-local tzone", { 382 x <- interval(tzone = "") 383 y <- interval(tzone = "America/Los_Angeles") 384 385 expect_identical(vec_ptype2(x, y)@tzone, "America/Los_Angeles") 386 expect_identical(vec_ptype2(y, x)@tzone, "America/Los_Angeles") 387 388 expect_identical(tz(int_start(vec_ptype2(x, y))), "America/Los_Angeles") 389 expect_identical(tz(int_start(vec_ptype2(y, x))), "America/Los_Angeles") 390}) 391 392test_that("common tzone is order dependent", { 393 x <- interval(tzone = "America/New_York") 394 y <- interval(tzone = "America/Los_Angeles") 395 396 expect_identical(vec_ptype2(x, y)@tzone, "America/New_York") 397 expect_identical(vec_ptype2(y, x)@tzone, "America/Los_Angeles") 398 399 expect_identical(tz(int_start(vec_ptype2(x, y))), "America/New_York") 400 expect_identical(tz(int_start(vec_ptype2(y, x))), "America/Los_Angeles") 401}) 402 403test_that("common type of Interval and NULL exists", { 404 expect_identical(vec_ptype2(interval(), NULL), interval()) 405 expect_identical(vec_ptype2(NULL, interval()), interval()) 406}) 407 408test_that("common type of Interval and unspecified exists", { 409 expect_identical(vec_ptype2(interval(), NA), interval()) 410 expect_identical(vec_ptype2(NA, interval()), interval()) 411 412 expect_identical(vec_ptype2(interval(), unspecified()), interval()) 413 expect_identical(vec_ptype2(unspecified(), interval()), interval()) 414}) 415 416# ------------------------------------------------------------------------------ 417# Interval - cast 418 419test_that("Interval default cast method falls through to `vec_default_cast()`", { 420 verify_errors({ 421 expect_error(vec_cast(interval(), 1), class = "vctrs_error_incompatible_type") 422 expect_error(vec_cast(1, interval()), class = "vctrs_error_incompatible_type") 423 }) 424}) 425 426test_that("Interval can be cast to Interval", { 427 expect_identical(vec_cast(interval(), interval()), interval()) 428}) 429 430test_that("can cast to a different tzone", { 431 x_tzone <- "America/Los_Angeles" 432 x_start <- as.POSIXct("1970-01-01", tz = x_tzone) 433 x_end <- as.POSIXct("1970-01-02", tz = x_tzone) 434 x <- interval(x_start, x_end, x_tzone) 435 436 to_tzone <- "America/New_York" 437 to <- interval(tzone = to_tzone) 438 439 expect_start <- with_tz(x_start, to_tzone) 440 expect_end <- with_tz(x_end, to_tzone) 441 expect <- interval(expect_start, expect_end, to_tzone) 442 443 expect_identical(vec_cast(x, to), expect) 444}) 445 446test_that("can cast around `NULL`", { 447 expect_identical(vec_cast(NULL, interval()), NULL) 448 expect_identical(vec_cast(interval(), NULL), interval()) 449}) 450 451test_that("can cast unspecified to Interval", { 452 expect_identical(vec_cast(NA, interval()), interval()[NA_real_]) 453 expect_error(vec_cast(interval(), NA), class = "vctrs_error_incompatible_type") 454}) 455 456# ------------------------------------------------------------------------------ 457# Interval - vctrs functionality 458 459test_that("can slice Interval objects", { 460 x <- interval(c("1970-01-01", "1970-01-02")) 461 expect_identical(vec_slice(x, 2:1), x[2:1]) 462}) 463 464test_that("slicing preserves names", { 465 skip_if_cant_set_s4_names() 466 x <- interval(c("1970-01-01", "1970-01-02")) 467 x <- stats::setNames(x, c("x", "y")) 468 expect_named(vec_slice(x, c(1, 1, 2)), c("x", "x", "y")) 469}) 470 471test_that("can combine Interval objects", { 472 x <- interval("1970-01-01") 473 y <- interval("1970-01-02") 474 expect <- interval(c("1970-01-01", "1970-01-02")) 475 expect_identical(vec_c(x, y), expect) 476}) 477 478test_that("can row bind Interval objects", { 479 skip_if_cant_set_s4_names() 480 x <- interval("1970-01-01") 481 x_named <- stats::setNames(x, "x") 482 expect_identical(vec_rbind(x_named, x_named), data.frame(x = c(x, x))) 483}) 484 485test_that("can row bind data frames with Interval objects", { 486 x <- interval("1970-01-01") 487 488 expect_identical( 489 vec_rbind(data.frame(x = x), data.frame(x = x)), 490 data.frame(x = vec_c(x, x)) 491 ) 492}) 493 494test_that("can column bind Interval objects", { 495 x <- interval("1970-01-01") 496 y <- interval(c("1970-01-01", "1970-01-02")) 497 498 expect_identical( 499 vec_cbind(x = x, y = y), 500 data.frame(x = vec_c(x, x), y = y) 501 ) 502}) 503 504test_that("can column bind data frames with Interval objects", { 505 x <- interval("1970-01-01") 506 y <- interval(c("1970-01-01", "1970-01-02")) 507 508 expect_identical( 509 vec_cbind(data.frame(x = x), data.frame(y = y)), 510 data.frame(x = vec_c(x, x), y = y) 511 ) 512}) 513 514test_that("Interval objects can be ordered", { 515 x <- interval("1970-01-01", "1970-01-02") 516 y <- interval("1970-01-02", "1970-01-03") 517 z <- interval("1970-01-02", "1970-01-04") 518 519 # Different from `order()`! 520 expect_identical(vec_order(vec_c(y, x)), c(2L, 1L)) 521 522 expect_identical(vec_order(vec_c(z, y)), c(2L, 1L)) 523}) 524 525# ------------------------------------------------------------------------------ 526# Output 527 528test_that("vctrs methods have informative errors", { 529 verify_output(test_path("output", "test-vctrs.txt"), { 530 "# no common type when mixing Period/Duration/Interval" 531 vec_ptype2(period(), duration()) 532 vec_ptype2(duration(), period()) 533 534 vec_ptype2(period(), interval()) 535 vec_ptype2(interval(), period()) 536 537 vec_ptype2(duration(), interval()) 538 vec_ptype2(interval(), duration()) 539 540 "# can't cast between Period/Duration/Interval" 541 vec_cast(period(), duration()) 542 vec_cast(duration(), period()) 543 544 vec_cast(period(), interval()) 545 vec_cast(interval(), period()) 546 547 vec_cast(duration(), interval()) 548 vec_cast(interval(), duration()) 549 550 "# Period default ptype2 method falls through to `vec_default_ptype2()`" 551 vec_ptype2(period(), 1) 552 vec_ptype2(1, period()) 553 554 "# Period default cast method falls through to `vec_default_cast()`" 555 vec_cast(period(), 1) 556 vec_cast(1, period()) 557 558 "# Duration default ptype2 method falls through to `vec_default_ptype2()`" 559 vec_ptype2(duration(), 1) 560 vec_ptype2(1, duration()) 561 562 "# Duration default cast method falls through to `vec_default_cast()`" 563 vec_cast(duration(), 1) 564 vec_cast(1, duration()) 565 566 "# Interval default ptype2 method falls through to `vec_default_ptype2()`" 567 vec_ptype2(interval(), 1) 568 vec_ptype2(1, interval()) 569 570 "# Interval default cast method falls through to `vec_default_cast()`" 571 vec_cast(interval(), 1) 572 vec_cast(1, interval()) 573 }) 574}) 575 576