context("packs")
# Input data --------------------------------------------------------------
input <- list(1, dot2 = "a", mean, list(new = 2, 3))
compute_output_ref <- function(.extra_class) {
list(
structure(1, class = c(.extra_class, "rule_pack", "numeric")),
dot2 = structure("a", class = c(.extra_class, "rule_pack", "character")),
structure(mean, class = c(.extra_class, "rule_pack", "function")),
new = structure(2, class = c(.extra_class, "rule_pack", "numeric")),
structure(3, class = c(.extra_class, "rule_pack", "numeric"))
)
}
# data_packs --------------------------------------------------------------
test_that("data_packs works", {
output <- data_packs(!!!input)
output_ref <- compute_output_ref(.extra_class = "data_pack")
expect_identical(output, output_ref)
})
# group_packs -------------------------------------------------------------
test_that("group_packs works", {
output_1 <- group_packs(!!!input, .group_vars = c("x", "y"))
output_2 <- group_packs(
!!!input,
.group_vars = c("x", "y"),
.group_sep = "+"
)
output_ref <- compute_output_ref(.extra_class = "group_pack") %>%
lapply(`attr<-`, which = "group_vars", value = c("x", "y"))
output_ref_1 <- lapply(output_ref, `attr<-`, which = "group_sep", value = ".")
output_ref_2 <- lapply(output_ref, `attr<-`, which = "group_sep", value = "+")
expect_identical(output_1, output_ref_1)
expect_identical(output_2, output_ref_2)
})
test_that("group_packs throws errors", {
expect_error(group_packs(!!!input, .group_vars = character(0)))
expect_error(group_packs(!!!input, .group_vars = 1:2))
expect_error(group_packs(!!!input, .group_vars = "a", .group_sep = 1))
expect_error(
group_packs(!!!input, .group_vars = "a", .group_sep = c("+", "-"))
)
})
# col_packs ---------------------------------------------------------------
test_that("col_packs works", {
output <- col_packs(!!!input)
output_ref <- compute_output_ref(.extra_class = "col_pack")
expect_identical(output, output_ref)
})
# row_packs ---------------------------------------------------------------
test_that("row_packs works", {
output <- row_packs(!!!input)
output_ref <- compute_output_ref(.extra_class = "row_pack")
expect_identical(output, output_ref)
})
# cell_packs --------------------------------------------------------------
test_that("cell_packs works", {
output <- cell_packs(!!!input)
output_ref <- compute_output_ref(.extra_class = "cell_pack")
expect_identical(output, output_ref)
})
# squash_dots_rule_pack ---------------------------------------------------
test_that("squash_dots_rule_pack returns a list", {
output <- squash_dots_rule_pack(1, .extra_class = "extra")
names(output) <- NULL
output_ref <- list(structure(1, class = c("extra", "rule_pack", "numeric")))
expect_identical(output, output_ref)
})
test_that("squash_dots_rule_pack returns a named list", {
output <- squash_dots_rule_pack(!!!input[1:3], .extra_class = "extra")
output_ref <- compute_output_ref(.extra_class = "extra")[1:3]
expect_identical(output, output_ref)
})
test_that("squash_dots_rule_pack squashes", {
output <- squash_dots_rule_pack(
list(list(1L), list(2L, list(3L))),
list(list(list(4L)), list(5L, list(6L))),
.extra_class = "extra"
)
names(output) <- NULL
output_ref <- lapply(
1:6,
structure,
class = c("extra", "rule_pack", "integer")
)
expect_identical(output, output_ref)
})
# print.data_pack ---------------------------------------------------------
test_that("print.data_pack works", {
expect_output(print(data_packs(!!!input)[[1]]), "Data.*ule.*ack")
})
# print.group_pack --------------------------------------------------------
test_that("print.group_pack works", {
expect_output(
print(group_packs(!!!input, .group_vars = "a")[[1]]),
"Group.*ule.*ack"
)
})
# print.col_pack ----------------------------------------------------------
test_that("print.col_pack works", {
expect_output(print(col_packs(!!!input)[[1]]), "Column.*ule.*ack")
})
# print.row_pack ----------------------------------------------------------
test_that("print.row_pack works", {
expect_output(print(row_packs(!!!input)[[1]]), "Row.*ule.*ack")
})
# print.cell_pack ---------------------------------------------------------
test_that("print.cell_pack works", {
expect_output(print(cell_packs(!!!input)[[1]]), "Cell.*ule.*ack")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.