test_that("make_explicit_top works for dateless dimension lists", { top <- c(1, 2, 3) dimensions <- c("one", "two", "three") expect_equal( make_explicit_top(top, dimensions), c("one" = 1, "two" = 2, "three" = 3) ) }) test_that("make_explicit_top works for explicit date dimension lists", { top <- c(5, 5, 5) dimensions <- c("one", "daterangeday", "three") dimensions2 <- c("daterangeweek", "two", "three") expect_equal( make_explicit_top(top, dimensions), c("one" = 5, "daterangeday" = 5, "three" = 5) ) expect_equal( make_explicit_top(top, dimensions2), c("daterangeweek" = 5, "two" = 5, "three" = 5) ) }) test_that("make_explicit_top recycles 'top' to fit dimensions", { top <- 5 dimensions <- c("one", "two", "three") expect_equal( make_explicit_top(top, dimensions), c("one" = 5, "two" = 5, "three" = 5) ) }) test_that("make_explicit_top returns 0 for first-position date variables with recycled 'top' argument", { date_dimensions <- paste0("daterange", c("minute", "hour", "day", "week", "month", "quarter", "year")) top <- 5 # Check all date dimensions lapply(date_dimensions, function(datedim) { dimensions <- c(datedim, "two", "three") expect_equal( make_explicit_top(top, dimensions), setNames(c(0, 5, 5), dimensions) ) }) }) test_that("make_explicit_top does not replace the first date variable's 'top' when length(dimensions) == 1", { date_dimensions <- paste0("daterange", c("minute", "hour", "day", "week", "month", "quarter", "year")) top <- 5 # Check all date dimensions lapply(date_dimensions, function(datedim) { dimensions <- datedim expect_equal( make_explicit_top(top, dimensions), setNames(5, dimensions) ) }) }) test_that("make_explicit_top accepts an implied first value when length(top) == length(dimensions) - 1", { date <- "daterangeday" dimensions <- c("one", "two", "three", "four") top <- c(1, 2, 3, 4) for (i in 1:4) { t <- top[1:i] d <- c(date, dimensions[1:i]) exp_result <- setNames( c(0, t), d ) expect_equal( make_explicit_top(t, d), exp_result ) } }) test_that("make_explicit_top throws an error with incompatible top/dimension combinations", { # top > 1 and length(top) != length(dimensions) expect_error( make_explicit_top(1:4, c("one", "two")), "Invalid combination of 'top' and 'dimensions'" ) # length(top) == length(dimensions) - 1 but first dimension is not a date expect_error( make_explicit_top(1:2, c("one", "two", "three")), "Invalid combination of 'top' and 'dimensions'" ) }) test_that("make_explicit_top throws an error if any value of 'top' is NA", { expect_error( make_explicit_top(c(NA, 2, 3), c("one", "two", "three")), "Elements 1 of .* are not true" ) expect_error( make_explicit_top(c(NA, 2, NA), c("daterangeday", "two", "three")), "Elements 1, 3 of .* are not true" ) }) # These all use the same difftime function, and so can be grouped test_that("recalculate_top_arg replaces zeros with correct number of units (minute, hour, day, week)", { datetimes <- as.POSIXct(c("2022-01-01 00:00:00", "2022-01-01 03:00:00"), format = "%F %T") dates <- as.Date(c("2022-01-01", "2022-01-10")) minute_res <- recalculate_top_arg(5, c("daterangeminute", "dim1", "dim2"), datetimes) hour_res <- recalculate_top_arg(5, c("daterangehour", "dim1", "dim2"), datetimes) day_res <- recalculate_top_arg(5, c("daterangeday", "dim1", "dim2"), dates) week_res <- recalculate_top_arg(5, c("daterangeweek", "dim1", "dim2"), dates) expect_equal( minute_res, c("daterangeminute" = 180, "dim1" = 5, "dim2" = 5) ) expect_equal( hour_res, c("daterangehour" = 3, "dim1" = 5, "dim2" = 5) ) expect_equal( day_res, c("daterangeday" = 10, "dim1" = 5, "dim2" = 5) ) expect_equal( week_res, c("daterangeweek" = 2, "dim1" = 5, "dim2" = 5) ) }) test_that("recalculate_top_arg replaces zeros with correct number of units (month, quarter)", { dates <- as.Date(c("2020-05-01", "2021-04-30")) dims_month <- c("daterangemonth", "dim1", "dim2") dims_quarter <- c("daterangequarter", "dim1", "dim2") month_res <- recalculate_top_arg(c(0, 1, 2), dims_month, dates) quarter_res <- recalculate_top_arg(c(0, 1, 2), dims_quarter, dates) expect_equal( month_res, setNames(c(12, 1, 2), dims_month) ) expect_equal( quarter_res, setNames(c(5, 1, 2), dims_quarter) ) }) test_that("recalculate_top_arg replaces zeros with correct number of units (year)", { dates <- as.Date(c("2019-01-01", "2022-10-31")) dims <- c("daterangeyear", "dim2", "dim3") expect_equal( recalculate_top_arg(c(0, 15, 15), dims, dates), setNames( c(4, 15, 15), dims ) ) }) test_that("recalculate_top_arg also replaces 0s in the middle of the dimension list", { # Rotates a vector so I can vary the position of the different values roll <- function(x, n) { if (n == 0) return(x) c(tail(x, n), head(x, -n)) } dates <- as.Date(c("2020-05-01", "2021-04-30")) dims <- c("daterangeday", "dim2", "daterangeweek", "dim4", "dim5") top <- c(0, 2, 0, 3, 4) # Base case: multiple zeros will be replaced if they satisfy the conditions expect_equal( recalculate_top_arg(top, dims, dates), setNames(c(365, 2, 53, 3, 4), dims) ) # Rotate inputs to ensure position doesn't affect results for (i in 1:4) { rot_dim <- roll(dims, i) rot_top <- roll(top, i) res <- recalculate_top_arg(rot_top, rot_dim, dates) exp_res <- roll(recalculate_top_arg(top, dims, dates), i) expect_equal( res, exp_res ) } }) test_that("recalculate_top_arg does not replace explicit 'top' date dimension values", { dates <- as.Date(c("2020-05-01", "2021-04-30")) dims <- c("daterangeday", "dim2", "daterangeweek", "dim4", "dim5") top <- c(10, 2, 10, 3, 4) expect_equal( recalculate_top_arg(top, dims, dates), setNames(top, dims) ) }) # TODO How are NAs handled by recalculate_top_arg? # test_that("recalculate_top_arg ", { # }) # Examples # recalculate_top_arg(0, "daterangeday", as.Date(c("2021-01-01", "2021-01-10"))) # recalculate_top_arg(0, "daterangeday", c("2021-01-01", "2021-01-10"))