Nothing
context("Subtotals and headings")
# Skip tests on windows (because they're slow and CRAN complains)
if (tolower(Sys.info()[["sysname"]]) != "windows") {
test_that("Subtotal accepts a variety of inputs", {
subtot1 <- Subtotal(name = "Approval", categories = c(1, 2), after = 2)
expect_true(is.Subtotal(subtot1))
subtot2 <- Subtotal(name = "Approval", categories = list(1, 2), after = 2)
expect_true(is.Subtotal(subtot2))
subtot3 <- Subtotal(name = "Approval", categories = list(1:2), after = 2)
expect_true(is.Subtotal(subtot3))
expect_equal(subtot1, subtot2)
expect_equal(subtot2, subtot3)
subtot_top <- Subtotal(name = "Approval", categories = c(1, 2), position = "top")
subtot_bottom <- Subtotal(name = "Approval", categories = c(1, 2), position = "bottom")
subtot_after_last_cat <- Subtotal(name = "Approval", categories = c(1, 2))
expect_message(
expect_equal(anchor(subtot_after_last_cat), NA_integer_),
paste0(
"Can't determine the anchor position without a ",
"variable. However, when this is added to a Crunch ",
"variable or CrunchCube it will follow the last ",
"category given"
)
)
})
test_that("Subtotal validates", {
expect_error(
Subtotal(categories = c(1, 2), after = 2),
"argument \"name\" is missing, with no default"
)
expect_error(
Subtotal(name = "Total Approval", after = 2),
"Must specify at least one of categories or negative for a valid Subtotal"
)
expect_error(
Subtotal(name = "Total Approval", categories = 1, before = 1, after = 2),
"Cannot specify both the .*after.* and .*before.* arguments"
)
})
test_that("Subtotal validates with fixed positions", {
expect_error(
Subtotal(categories = c(1, 2), after = 2, position = "top"),
paste0(
"If position is not relative, you cannot supply a category id ",
"or name to the .*after.* argument"
)
)
expect_error(
Subtotal(
name = "Total Approval", categories = c(1, 2),
position = "not a position"
),
"'arg' should be one of .*relative.*, .*top.*, .*bottom.*"
)
})
test_that("Heading validates", {
expect_error(
Heading(after = 2),
"argument \"name\" is missing, with no default"
)
expect_error(Heading(name = "All the approves", after = 2, categories = c(1, 2)),
"unused argument (categories = c(1, 2))",
fixed = TRUE
)
})
subtot <- Subtotal(name = "a subtotal", after = 1, categories = c(1, 2))
heading <- Heading(name = "a heading", position = "top")
test_that("Subtotal/Heading getters", {
expect_equal(func(subtot), "subtotal")
expect_equal(func(heading), NA)
expect_equal(arguments(heading), NA)
})
test_that("Subtotal/Heading setters", {
# names
name(subtot) <- "new name"
expect_equal(name(subtot), "new name")
name(heading) <- "new head"
expect_equal(name(heading), "new head")
# arguments
arguments(subtot) <- c(2, 3)
expect_equal(arguments(subtot), c(2, 3))
expect_error(
arguments(heading) <- c(2, 3),
"Cannot set arguments on Headings."
)
# anchors
anchor(subtot) <- 2
expect_equal(anchor(subtot), 2)
expect_equal(subtot$position, "relative")
anchor(subtot) <- "bottom"
# anchor grabs position when after is null
expect_equal(anchor(subtot), "bottom")
expect_equal(subtot$position, "bottom")
# after is null when position is anything other than relative
expect_null(subtot$after)
anchor(heading) <- 1
expect_equal(anchor(heading), 1)
expect_equal(heading$position, "relative")
})
with_mock_crunch({
ds <- cachedLoadDataset("test ds")
test_that("subtotals retrieves the subtotals and headings Insertions", {
expect_equivalent(
subtotals(ds$location),
Insertions(data = list(
Subtotal(
name = "London+Scotland", after = 3,
categories = c(1, 2)
)
))
)
})
test_that("can update a subtotals' name, arguments, and anchor", {
expect_PATCH(
anchor(subtotals(ds$location)[[1]]) <- 1,
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":',
'{"insertions":[{"anchor":1,"name":"London+Scotland",',
'"function":"subtotal","args":[1,2],"kwargs":{"positive":[1,2]},"id":1}]}}}'
)
expect_PATCH(
name(subtotals(ds$location)[[1]]) <- "new name",
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":',
'{"insertions":[{"anchor":3,"name":"new name",',
'"function":"subtotal","args":[1,2],"kwargs":{"positive":[1,2]},"id":1}]}}}'
)
expect_PATCH(
arguments(subtotals(ds$location)[[1]]) <- c(2, 3),
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":',
'{"insertions":[{"anchor":3,"name":"London+Scotland",',
'"function":"subtotal","args":[2,3],"kwargs":{"positive":[2,3]},"id":1}]}}}'
)
})
test_that("subtotals returns null when there are no subtotals", {
expect_null(subtotals(ds$gender))
})
test_that("Assigning NULL if already NULL does nothing", {
expect_no_request(subtotals(ds$gender) <- NULL)
})
test_that("Adding subtotals and headers to a variable that has none, works", {
expect_PATCH(
subtotals(ds$gender) <- list(
Subtotal(name = "Not men", categories = c(1, -1), after = "Female"),
Subtotal(name = "Women", categories = "Female", after = 4),
Heading(name = "A subtitle", position = "top")
),
"https://app.crunch.io/api/datasets/1/variables/gender/",
'{"view":{"transform":{"insertions":[',
'{"anchor":2,"name":"Not men","function":"subtotal","args":[1,-1],"kwargs":',
'{"positive":[1,-1]},"id":1},',
'{"anchor":4,"name":"Women","function":"subtotal","args":[2],"kwargs":',
'{"positive":[2]},"id":2},',
'{"anchor":"top","name":"A subtitle","id":3}]}}}'
)
})
test_that("Can add subtotal difference", {
expect_PATCH(
subtotals(ds$gender) <- list(
Subtotal(name = "W-M", categories = 2, after = "Female", negative = 1)
),
"https://app.crunch.io/api/datasets/1/variables/gender/",
'{"view":{"transform":{"insertions":[',
'{"anchor":2,"name":"W-M","function":"subtotal","args":[2],"kwargs":',
'{"positive":[2],"negative":[1]},"id":1}]}}}'
)
})
test_that("When after is not supplied, it defauls to follow the last category", {
expect_PATCH(
subtotals(ds$gender) <- list(
# categories supplied in reverse order
Subtotal(name = "Not men", categories = c(-1, 1)),
Subtotal(name = "Women", categories = "Female")
),
"https://app.crunch.io/api/datasets/1/variables/gender/",
'{"view":{"transform":{"insertions":[',
'{"anchor":-1,"name":"Not men","function":"subtotal","args":[-1,1],"kwargs":',
'{"positive":[-1,1]},"id":1},',
'{"anchor":2,"name":"Women","function":"subtotal","args":[2],"kwargs":',
'{"positive":[2]},"id":2}]}}}'
)
# one supplied category (23) isn't a real category, after should still be -1
expect_PATCH(
subtotals(ds$gender) <- list(
# categories supplied in reverse order
Subtotal(name = "Not men", categories = c(-1, 1, 23)),
Subtotal(name = "Women", categories = "Female")
),
"https://app.crunch.io/api/datasets/1/variables/gender/",
'{"view":{"transform":{"insertions":[',
'{"anchor":-1,"name":"Not men","function":"subtotal","args":[-1,1,23],"kwargs":',
'{"positive":[-1,1,23]},"id":1},',
'{"anchor":2,"name":"Women","function":"subtotal","args":[2],"kwargs":',
'{"positive":[2]},"id":2}]}}}'
)
})
test_that("subtotals and headers to a variable that has some, appends", {
expect_PATCH(
subtotals(ds$location) <- list(
Subtotal(name = "London alone", categories = c(1), after = "London"),
Subtotal(name = "Scotland alone", categories = "Scotland", after = 2),
Heading(name = "A subtitle", position = "top")
),
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":{"insertions":[',
'{"anchor":1,"name":"London alone","function":"subtotal","args":[1],"kwargs":',
'{"positive":[1]},"id":1},',
'{"anchor":2,"name":"Scotland alone","function":"subtotal","args":[2],"kwargs":',
'{"positive":[2]},"id":2},',
'{"anchor":"top","name":"A subtitle","id":3}]}}}'
)
})
test_that("subtotals don't duplicate, they replace", {
expect_PATCH(
subtotals(ds$location) <- list(
Subtotal(
name = "London+Scotland", categories = c(2, 1),
position = "top"
)
),
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":{"insertions":[',
'{"anchor":"top","name":"London+Scotland","function":"subtotal","args":',
'[2,1],"kwargs":{"positive":[2,1]},"id":1}]}}}'
)
})
test_that("headings don't duplicate, they replace", {
expect_PATCH(
subtotals(ds$location) <- list(
Heading(name = "London+Scotland", after = 1)
),
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":{"insertions":[',
'{"anchor":1,"name":"London+Scotland","id":1}]}}}'
)
})
test_that("bare subtotals and headers can be added", {
expect_PATCH(
subtotals(ds$location) <-
Subtotal(name = "London alone", categories = c(1), after = "London"),
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":{"insertions":[',
'{"anchor":1,"name":"London alone","function":"subtotal","args":[1],"kwargs":',
'{"positive":[1]},"id":1}]}}}'
)
expect_PATCH(
subtotals(ds$location) <-
Heading(name = "A subtitle", position = "top"),
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":{"insertions":[',
'{"anchor":"top","name":"A subtitle","id":1}]}}}'
)
})
test_that("subtotals and headers can be removed", {
expect_PATCH(
subtotals(ds$location) <- NULL,
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":{"insertions":[]}}}'
)
})
test_that("subtotals respect ids if provided", {
expect_PATCH(
subtotals(ds$location) <- list(
Subtotal(name = "London alone", categories = c(1), after = "London"),
Subtotal(name = "Scotland alone", categories = "Scotland", after = 2, id = 1)
),
"https://app.crunch.io/api/datasets/1/variables/location/",
'{"view":{"transform":{"insertions":[',
'{"anchor":1,"name":"London alone","function":"subtotal","args":[1],"kwargs":',
'{"positive":[1]},"id":2},',
'{"anchor":2,"name":"Scotland alone","function":"subtotal","args":[2],"kwargs":',
'{"positive":[2]},"id":1}]}}}'
)
})
test_that("can add MR Subtotals", {
expect_PATCH(
subtotals(ds$mymrset) <- list(
Subtotal(name = "s1 or s2", c("subvar1", "subvar2"), position = "top")
),
"https://app.crunch.io/api/datasets/1/variables/mymrset/",
'{"view":{"transform":{"insertions":[{"anchor":"top","name":"s1 or s2",',
'"function":"any_non_missing_selected","kwargs":{"variable":',
'"mymrset","subvariable_ids":["subvar1","subvar2"]},"id":1}]}}}'
)
})
test_that("can add MR Subtotals with after position", {
expect_PATCH(
subtotals(ds$mymrset) <- list(
Subtotal(name = "s1 or s2", c("subvar1", "subvar2"), after = "subvar1")
),
"https://app.crunch.io/api/datasets/1/variables/mymrset/",
'{"view":{"transform":{"insertions":[{"anchor":{"position":"after","alias":',
'"subvar1"},"name":"s1 or s2","function":"any_non_missing_selected","kwargs":',
'{"variable":"mymrset","subvariable_ids":["subvar1","subvar2"]},"id":1}]}}}'
)
})
test_that("can add MR Subtotals with before position", {
expect_PATCH(
subtotals(ds$mymrset) <- list(
Subtotal(name = "s1 or s2", c("subvar1", "subvar2"), before = "subvar1")
),
"https://app.crunch.io/api/datasets/1/variables/mymrset/",
'{"view":{"transform":{"insertions":[{"anchor":{"position":"before","alias":',
'"subvar1"},"name":"s1 or s2","function":"any_non_missing_selected","kwargs":',
'{"variable":"mymrset","subvariable_ids":["subvar1","subvar2"]},"id":1}]}}}'
)
})
test_that("can add MR Subtotals with na.rm=FALSE", {
expect_PATCH(
subtotals(ds$mymrset) <- list(
Subtotal(
name = "s1 or s2", c("subvar1", "subvar2"), position = "top", na.rm = FALSE
)
),
"https://app.crunch.io/api/datasets/1/variables/mymrset/",
'{"view":{"transform":{"insertions":[{"anchor":"top","name":"s1 or s2",',
'"function":"any_selected","kwargs":{"variable":',
'"mymrset","subvariable_ids":["subvar1","subvar2"]},"id":1}]}}}'
)
})
test_that("can add MR Subtotals with subvar names", {
expect_PATCH(
subtotals(ds$mymrset) <- list(
# Confusing thing: name="Second" matches alias="subvar1"
Subtotal(name = "s1 or s2", c("Second", "First"), after = "Second")
),
"https://app.crunch.io/api/datasets/1/variables/mymrset/",
'{"view":{"transform":{"insertions":[{"anchor":{"position":"after","alias":',
'"subvar1"},"name":"s1 or s2","function":"any_non_missing_selected","kwargs":',
'{"variable":"mymrset","subvariable_ids":["subvar1","subvar2"]},"id":1}]}}}'
)
})
test_that("can add MR Subtotals with default position", {
expect_PATCH(
subtotals(ds$mymrset) <- list(
Subtotal(name = "s1 or s2", c("subvar1", "subvar2"))
),
"https://app.crunch.io/api/datasets/1/variables/mymrset/",
'{"view":{"transform":{"insertions":[{"anchor":{"position":"after","alias":',
'"subvar1"},"name":"s1 or s2","function":"any_non_missing_selected","kwargs":',
'{"variable":"mymrset","subvariable_ids":["subvar1","subvar2"]},"id":1}]}}}'
)
})
test_that("can add MR Subtotals with explicit alias", {
expect_PATCH(
subtotals(ds$mymrset) <- list(
Subtotal(
name = "s1 or s2",
c("subvar1", "subvar2"),
position = "top",
alias = "top2"
)
),
"https://app.crunch.io/api/datasets/1/variables/mymrset/",
'{"view":{"transform":{"insertions":[{"anchor":"top","name":"s1 or s2",',
'"function":"any_non_missing_selected","kwargs":{"variable":',
'"mymrset","subvariable_ids":["subvar1","subvar2"]},"alias":"top2","id":1}]}}}'
)
})
test_that("reasonable error when MR subvariables don't match aliases nor names", {
expect_error(
subtotals(ds$mymrset) <- list(
Subtotal(name = "bad", c("ABC", "subvar2"), position = "top")
),
"`subvariable_ids` must be all aliases or all names, but"
)
})
test_that("can use subtypeInsertion on handcrafted MR insertions", {
inserts <- Insertions(Insertion(
anchor = "top",
`function` = "any_selected",
name = "s1 or s2",
id = 1L,
kwargs = list(
variable = "mymrset",
subvariable_ids = c("subvar1", "subvar2")
),
alias = NULL
))
expect_equal(
subtypeInsertions(inserts),
Insertions(Subtotal(
"s1 or s2",
c("subvar1", "subvar2"),
position = "top",
id = 1L,
variable = "mymrset"
))
)
})
ds_veg <- cachedLoadDataset("Vegetables example") ## Has MR insertions
test_that("can print an mr subtotal", {
expect_prints(
subtotals(ds_veg$funnel_aware_mr),
get_output(data.frame(
anchor = c("top"),
name = c("Jicama or Kohlrabi"),
func = c("subtotal"),
args = c("funnel_aware_mr_1 and funnel_aware_mr_2"),
kwargs = c(""),
stringsAsFactors = FALSE
)),
fixed = TRUE
)
})
})
with_test_authentication({
ds <- newDataset(df)
trans <- Transforms(insertions = list(
Subtotal(
position = "top",
name = "B-C",
categories = 1,
negative = 2
),
Subtotal(
after = 1, name = "B alone",
categories = c(1)
),
Subtotal(
after = 2, name = "C alone",
categories = c(2)
),
Subtotal(
position = "bottom", name = "B+C",
categories = c(1, 2)
)
))
trans_resp <- trans
trans_resp["categories"] <- list(NULL)
trans_resp["elements"] <- list(NULL)
test_that("Can get and set headings and subtotals", {
expect_null(transforms(ds$v4))
subtotals(ds$v4) <- list(
Subtotal(
position = "top",
name = "B-C",
categories = 1,
negative = 2
),
Subtotal(
name = "B alone", categories = c("B"),
after = 1
),
Subtotal(
name = "C alone", categories = c(2),
after = "C"
),
Subtotal(
name = "B+C", categories = c(1, 2),
position = "bottom"
)
)
expect_json_equivalent(transforms(ds$v4), trans_resp)
expect_prints(subtotals(ds$v4),
get_output(data.frame(
anchor = c("top", 1, 2, "bottom"),
name = c("B-C", "B alone", "C alone", "B+C"),
func = c("subtotal", "subtotal", "subtotal", "subtotal"),
args = c("1", "1", "2", "1 and 2"),
kwargs = c(
"positive: 1 | negative: 2",
"positive: 1 | ",
"positive: 2 | ",
"positive: 1 and 2 | "
),
stringsAsFactors = FALSE
)),
fixed = TRUE
)
# check shape
v4_ary <- array(c(0, 10, 10, 10, 10, 20),
dimnames = list(c(
"B-C", "B", "B alone",
"C", "C alone", "B+C"
))
)
# capture.output so that we don't print during the test.
capture.output(v4_with_trans <- showTransforms(ds$v4))
expect_equivalent(v4_with_trans, v4_ary)
})
test_that("Can modify subtotals in place", {
# assert known shape
expect_equal(names(subtotals(ds$v4)), c(
"B-C", "B alone",
"C alone", "B+C"
))
expect_equal(anchors(subtotals(ds$v4)), c("top", 1, 2, "bottom"))
expect_equal(arguments(subtotals(ds$v4)[[1]]), 1)
expect_equal(arguments(subtotals(ds$v4)[[2]]), 1)
expect_equal(arguments(subtotals(ds$v4)[[3]]), 2)
expect_equal(arguments(subtotals(ds$v4)[[4]]), c(1, 2))
# changing names
name(subtotals(ds$v4)[[2]]) <- "C and B"
expect_equal(name(subtotals(ds$v4)[[2]]), "C and B")
# changing anchors
anchor(subtotals(ds$v4)[[2]]) <- 2
expect_equal(anchor(subtotals(ds$v4)[[2]]), 2)
anchor(subtotals(ds$v4)[[2]]) <- "B"
expect_equal(anchor(subtotals(ds$v4)[[2]]), 1)
anchor(subtotals(ds$v4)[[3]]) <- 1
expect_equal(anchor(subtotals(ds$v4)[[3]]), 1)
anchor(subtotals(ds$v4)[[1]]) <- "bottom"
expect_equal(anchor(subtotals(ds$v4)[[1]]), "bottom")
# changing arguments
arguments(subtotals(ds$v4)[[2]]) <- c(1, 2)
expect_equal(arguments(subtotals(ds$v4)[[2]]), c(1, 2))
arguments(subtotals(ds$v4)[[2]]) <- c("C", "B")
expect_equal(arguments(subtotals(ds$v4)[[2]]), c(2, 1))
# refresh to ensure that the changes have stuck
ds <- refresh(ds)
expect_equal(names(subtotals(ds$v4)), c("B-C", "C and B", "C alone", "B+C"))
expect_equal(anchors(subtotals(ds$v4)), c("bottom", 1, 1, "bottom"))
expect_equal(arguments(subtotals(ds$v4)[[1]]), 1)
expect_equal(arguments(subtotals(ds$v4)[[2]]), c(2, 1))
expect_equal(arguments(subtotals(ds$v4)[[3]]), 2)
expect_equal(arguments(subtotals(ds$v4)[[4]]), c(1, 2))
})
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.