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