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)) }) }) }