context("subsetting tests")
d <- as.Date("2018-12-31") + 0:14
x <- date2week(d, week_start = "Monday")
f <- date2week(d, week_start = "Monday", factor = TRUE, floor_day = TRUE)
y <- date2week(d, week_start = "Saturday")
dd <- date2week(c(d, as.Date("2019-01-15")), week_start = "Monday")
test_that("subsetting returns an aweek object", {
expect_identical(x[], x)
expect_is(x[1], "aweek")
expect_is(y[1], "aweek")
expect_is(f[1], "aweek")
expect_identical(as.Date(x[1]), d[1])
expect_identical(as.Date(y[1]), d[1])
expect_identical(as.Date(f[1]), d[1])
expect_is(as.list(x)[[1]], "aweek")
expect_is(as.list(y)[[1]], "aweek")
expect_is(as.list(f)[[1]], "aweek")
expect_is(as.list(f)[[1]], "factor")
expect_identical(as.Date(as.list(x)[[1]]), d[1])
expect_identical(as.Date(as.list(y)[[1]]), d[1])
expect_identical(as.Date(as.list(f)[[1]]), d[1])
expect_is(x[[1]], "aweek")
expect_is(y[[1]], "aweek")
expect_is(f[[1]], "aweek")
expect_identical(as.Date(x[[1]]), d[1])
expect_identical(as.Date(y[[1]]), d[1])
expect_identical(as.Date(f[[1]]), d[1])
})
test_that("aweek objects can be ammended", {
xx <- rev(x)
# ammended with missing
xx[1] <- NA
expect_identical(xx[1], as.aweek(NA_character_, week_start = get_week_start(xx)))
# ammended with aweek objects
xx[1] <- x[1]
expect_identical(xx[1], x[1])
# ammended with dates
xx[2] <- as.Date(x[2])
expect_identical(xx[2], x[2])
# ammended with ISO week character strings
xx[3] <- as.character(x[3])
expect_identical(xx[3], x[3])
# entire object can be replaced
xx[] <- x
expect_identical(xx, x)
# factors can be ammended
xx[c(1, 8, 15)] <- factor_aweek(x[c(1, 8, 15)])
expect_identical(xx, x)
expect_error(y[1] <- x[1], "aweek objects must have the same week_start attribute")
expect_error(y[1] <- "1999-01-01", "The first incorrect string was: '1999-01-01'")
base <- "Cannot add an object of class '%s' to an aweek object"
expect_error(y[1] <- NULL, sprintf(base, "NULL"))
})
test_that("change_week_start() only works on aweek objects", {
expect_error(change_week_start("2018-W01-1"), "x must be an aweek object")
expect_identical(change_week_start(x, get_week_start(x)), x)
expect_identical(change_week_start(x, "Saturday"), y)
})
test_that("concatenation returns aweek object with the correct week_start attribute", {
expect_error(xy <- c(x, y), "All aweek objects must have the same week_start attribute.")
expect_error(yx <- c(y, x), "All aweek objects must have the same week_start attribute.")
xy <- c(x, change_week_start(y, get_week_start(x)))
yx <- c(y, change_week_start(x, get_week_start(y)))
expect_identical(attr(xy, "week_start"), 1L)
expect_identical(attr(yx, "week_start"), 6L)
})
test_that("truncation works", {
expect_identical(trunc(x), date2week(d, week_start = 1, floor_day = TRUE))
expect_identical(trunc(y), date2week(d, week_start = 6, floor_day = TRUE))
expect_identical(trunc(f), date2week(d, week_start = 1, floor_day = TRUE, factor = TRUE))
})
test_that("rep works", {
expect_identical(as.Date(rep(y, each = 2)), rep(d, each = 2))
expect_identical(as.Date(rep(x, each = 2)), rep(d, each = 2))
expect_true(all(as.Date(rep(f, each = 2)) <= rep(d, each = 2)))
})
test_that("characters can be added", {
xw <- c(x, "2019-W03-2")
xd <- c(x, "2019-01-15")
expect_identical(xw, dd)
expect_identical(xw, xd)
})
test_that("factors don't force factors", {
xf <- c(date2week(d[1], week_start = "Monday", factor = TRUE), x[-1])
expect_is(xf, "aweek")
expect_failure(expect_is(xf, "factor"))
expect_true(all(as.Date(xf) <= as.Date(x)))
})
test_that("dates can be added", {
xd <- c(x, as.Date("2019-01-15"))
expect_identical(xd, dd)
})
test_that("POSIXt objects can be added", {
xp <- c(x, as.POSIXlt("2019-01-15", tz = "UTC"))
xc <- c(x, as.POSIXct("2019-01-15", tz = "UTC"))
expect_identical(xp, xc)
expect_identical(xp, dd)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.