context("Interacting with decks") with_mock_crunch({ # Deck Catalog ------------------------------------------------------------ ds <- cachedLoadDataset("test ds deck") ds_veg <- cachedLoadDataset("Vegetables example") test_that("newDeck posts correctly", { expect_POST( newDeck(ds, "deck1"), "https://app.crunch.io/api/datasets/4/decks/", '{"element":"shoji:entity","body":{"name":"deck1"}}' ) }) deck_cat <- decks(ds) test_that("Deck Catalog can be retrieved", { expect_is(deck_cat, "DeckCatalog") expect_equal(length(deck_cat), 2) expect_equal(names(deck_cat), c("Main Deck", "Main Deck")) }) test_that("deck subsetting", { expect_warning( expect_GET( deck_cat[["Main Deck"]], "https://app.crunch.io/api/datasets/4/decks/f9b502afe2e54e79b3e17f3cc61174ae/" ), paste0( dQuote("Main Deck"), " does not uniquely identify elements. Returning the first match" ) ) expect_error( deck_cat[["Not a name"]], paste0(dQuote("Not a name"), " is not present in deck catalog") ) expect_error( deck_cat[[c("name 1", "name 2")]], "You can only select one deck at a time" ) }) main_deck <- deck_cat[[2]] # Crunch Decks ------------------------------------------------------------ test_that("Deck metadata", { expect_is(main_deck, "CrunchDeck") expect_equal(length(main_deck), 4) expect_equal(titles(main_deck), c("birthyr", "mymrset", "mymrset", "mymrset v2")) expect_equal(subtitles(main_deck), c("", "", "age", "")) }) test_that("deck catalog show method", { expected <- as.data.frame(deck_cat)[c("name", "team", "is_public", "owner_name")] expect_prints( deck_cat, get_output(expected) ) }) test_that("deck name and description getters and setters", { expect_equal(name(main_deck), "Main Deck") expect_equal(description(main_deck), "") expect_PATCH( name(main_deck) <- "new_name", "https://app.crunch.io/api/datasets/4/decks/8ad8/", '{"name":"new_name"}' ) expect_PATCH( description(main_deck) <- "new_description", "https://app.crunch.io/api/datasets/4/decks/8ad8/", '{"description":"new_description"}' ) }) test_that("deck titles and subtitles", { expect_equal(titles(main_deck), c("birthyr", "mymrset", "mymrset", "mymrset v2")) expect_PATCH( titles(main_deck) <- paste("slide", 1:4), "https://app.crunch.io/api/datasets/4/decks/8ad8/slides/", '{"element":"shoji:catalog","index":{', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/da161/":', '{"title":"slide 1"},', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/5938/":', '{"title":"slide 2"},', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/72e8/":', '{"title":"slide 3"},', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/72e9/":', '{"title":"slide 4"}}}' ) expect_PATCH( subtitles(main_deck) <- paste("slide", 1:4), "https://app.crunch.io/api/datasets/4/decks/8ad8/slides/", '{"element":"shoji:catalog","index":{', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/da161/":', '{"subtitle":"slide 1"},', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/5938/":', '{"subtitle":"slide 2"},', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/72e8/":', '{"subtitle":"slide 3"},', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/72e9/":', '{"subtitle":"slide 4"}}}' ) }) test_that("is.public method for decks", { expect_false(is.public(main_deck)) expect_PATCH( is.public(main_deck) <- TRUE, "https://app.crunch.io/api/datasets/4/decks/8ad8/", '{"is_public":true}' ) expect_no_request(is.public(deck_cat[[2]]) <- FALSE) }) test_that("teams on decks", { expect_null(team(deck_cat[[2]])) expect_PATCH( team(deck_cat[[2]]) <- getTeams()[[1]], "https://app.crunch.io/api/datasets/4/decks/8ad8/", '{"team":"https://app.crunch.io/api/teams/team1/"}' ) expect_no_request(team(deck_cat[[2]]) <- NULL) expect_error( team(deck_cat[[2]]) <- 4.2, "Team setting requires either a CrunchTeam entity, URL, or NULL" ) }) test_that("subset CrunchDecks", { expect_is(main_deck[[1]], "CrunchSlide") }) test_that("cube methods for crunch decks", { cube <- cube(main_deck[[1]]) expect_is(cube, "CrunchCube") expect_is(cube(main_deck[[2]]), "CrunchCube") expect_is(cube(main_deck[[4]]), "CrunchCube") cube_list <- cubes(main_deck) expect_is(cube_list, "list") expect_identical(cube, cube_list[[1]]) }) test_that("export decks generates correct POST", { expect_header( expect_POST( exportDeck(main_deck, format = "json"), "https://app.crunch.io/api/datasets/4/decks/8ad8/export/", body = '{"element":"shoji:entity","body":{}}'), "Accept: application/json" ) expect_header( expect_POST( exportDeck(main_deck, format = "xlsx"), "https://app.crunch.io/api/datasets/4/decks/8ad8/export/", body = '{"element":"shoji:entity","body":{}}' ), "Accept: application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" ) expect_header( expect_POST( exportDeck(main_deck, format = "pptx"), "https://app.crunch.io/api/datasets/4/decks/8ad8/export/", body = '{"element":"shoji:entity","body":{}}' ), "Accept: application/vnd.openxmlformats-officedocument.presentationml.presentation" ) # ... arguments are passed expect_header( expect_POST( exportDeck(main_deck, format = "json", slides = list(urls(slides(main_deck)[1]))), "https://app.crunch.io/api/datasets/4/decks/8ad8/export/", body = '{"element":"shoji:entity","body":{"slides":[', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/da161/"]}}'), "Accept: application/json" ) }) test_that("Deck export errors helpfully", { expect_error( exportDeck(ds, format = "json"), "exportDeck is only available for CrunchDecks." ) }) test_that("deck assignment", { expect_POST( main_deck[[5]] <- main_deck[[1]], "https://app.crunch.io/api/datasets/4/decks/8ad8/slides/", '{"element":"shoji:entity",', '"body":{"title":"birthyr",', '"subtitle":"",', '"analyses":[{"query":{"measures":{"count":{"function":"cube_count","args":[]}},', '"dimensions":[{"function":"bin","args":[{"variable":"https://app.', 'crunch.io/api/datasets/4/variables/000002/"}]}],', '"weight":null},', '"query_environment":{"filter":[],"weight":null},', '"display_settings":', '{"percentageDirection":{"value":"colPct"},', '"showEmpty":{"value":false},', '"showMean":{"value":true},', '"vizType":{"value":"table"},', '"countsOrPercents":{"value":"percent"},', '"decimalPlaces":{"value":1},', '"populationMagnitude":{"value":3},', '"showSignif":{"value":true},', '"currentTab":{"value":0},', '"uiView":{"value":"app.datasets.browse"}},', '"viz_specs":{"default":{"format":{"show_empty":true}}}}]}}' ) }) test_that("delete decks", { with_consent({ expect_DELETE( delete(main_deck), "https://app.crunch.io/api/datasets/4/decks/8ad8/" ) }) }) # Old fixtures haven't kept up with the API so use vegetables dataset # to test printing deck_veg <- decks(ds_veg)[[2]] test_that("Deck printing", { expect_prints( deck_veg, paste0( "Private CrunchDeck ", dQuote("2 deck about printing"), " with 3 slides:\n", " [[1]]: ", dQuote("donut"), " (donut)\n", " [[2]]: ", dQuote("table with filter and weight"), " | and a subtitle (table)\n", " [[3]]: | markdown slide (markdown)" ), fixed = TRUE, crayon.enabled = FALSE ) }) # Slide Catalog ----------------------------------------------------------- test_that("moveLastElement", { expect_equal(moveLastElement(1:5, 3), c(1, 2, 5, 4)) expect_equal(moveLastElement(1:5, 5), c(1, 2, 3, 4)) expect_equal(moveLastElement(1:5, 1), c(5, 2, 3, 4)) expect_equal(moveLastElement(1:5, 2), c(1, 5, 3, 4)) }) test_that("reorderSlides", { expect_PATCH( reorderSlides(slides(main_deck), c(4, 3, 2, 1)), "https://app.crunch.io/api/datasets/4/decks/8ad8/slides/flat", '{"element":"shoji:order",', '"self":"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/flat/",', '"description":"Order of the slides on this deck",', '"graph":["https://app.crunch.io/api/datasets/4/decks/8ad8/slides/72e9/",', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/72e8/",', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/5938/",', '"https://app.crunch.io/api/datasets/4/decks/8ad8/slides/da161/"]}' ) }) }) test_that("filter gets pass through method on non-crunch objects", { expect_equal( crunch::filter(1:100, rep(1, 3)), stats::filter(1:100, rep(1, 3)) ) }) with_test_authentication({ ds <- newDataset(df) test_that("decks can be created", { expect_is(decks(ds), "DeckCatalog") expect_equal(length(decks(ds)), 0) main_deck <- newDeck(ds, "MainDeck") expect_is(main_deck, "CrunchDeck") deck_cat <- decks(ds) expect_identical(deck_cat[[1]], main_deck) expect_equal(name(main_deck), "MainDeck") }) deck <- newDeck(ds, "deck") test_that("deck name getters and setters", { expect_equal(name(deck), "deck") name(deck) <- "new_name" expect_equal(name(deck), "new_name") }) test_that("deck description", { expect_equal(description(deck), "") description(deck) <- "description" expect_equal(description(deck), "description") }) test_that("setting deck publicness", { expect_false(is.public(deck)) is.public(deck) <- TRUE expect_true(is.public(deck)) }) settings <- list( percentageDirection = "colPct", showEmpty = FALSE, vizType = "histogram", countsOrPercents = "percent", decimalPlaces = 1L, populationMagnitude = 3L, showSignif = FALSE, currentTab = 0L, uiView = "app.datasets.analyze" ) test_that("slides can be added to a deck", { univariate_slide <- newSlide( deck, query = ~v1, display_settings = settings, title = "slide1", subtitle = "one analysis" ) expect_is(univariate_slide, "CrunchSlide") anCat <- analyses(univariate_slide) expect_is(anCat, "AnalysisCatalog") expect_equal(length(anCat), 1) }) test_that("can GET deck titles and subtitles", { slide_2 <- newSlide(deck, ~v2, settings, title = "slide2", subtitle = "two analyses") expect_equal(titles(deck), c("slide1", "slide2")) expect_equal(subtitles(deck), c("one analysis", "two analyses")) }) slideCat <- slides(deck) test_that("slides method", { expect_is(slideCat, "SlideCatalog") expect_equal(length(slideCat), 2) expect_equal(titles(slideCat), c("slide1", "slide2")) expect_equal(names(slideCat), c("slide1", "slide2")) }) test_that("slides can be added by assignment", { slide <- slideCat[[2]] expect_is(slide, "CrunchSlide") slideCat[[3]] <- slide expect_is(slideCat[[3]], "CrunchSlide") expect_equal(length(slideCat), 3) }) test_that("slide title can be changed", { slide <- slideCat[[2]] expect_equal(title(slide), "slide2") title(slide) <- "new_title2" expect_equal(title(slide), "new_title2") }) slide <- slideCat[[2]] anCat <- analyses(slide) test_that("analyses", { expect_is(anCat, "AnalysisCatalog") expect_equal(length(anCat), 1) }) analysis <- anCat[[1]] test_that("Analysis Catalog subset", { expect_is(analysis, "Analysis") }) test_that("analyses can be cubed", { expect_identical(cube(analysis), crtabs(~v2, ds)) }) test_that("cubes on an analysis catalog returns a list of cubes", { ancat <- analyses(slide) cube_list <- cubes(ancat) expect_is(cube_list, "list") expect_identical(length(cube_list), length(ancat)) expect_identical(cube_list[[1]], crtabs(~v2, ds)) }) test_that("Formulas can be assigned to analyses", { query(analysis) <- ~v3 expect_identical(cube(analysis), crtabs(~v3, ds)) }) test_that("display settings can be gotten and set", { ancat <- analyses(slide) analysis <- ancat[[1]] settings <- displaySettings(analysis) expect_is(settings, "list") expect_equal( sort(names(settings)), sort(c( "percentageDirection", "showEmpty", "showMean", "vizType", "countsOrPercents", "decimalPlaces", "populationMagnitude", "showSignif", "currentTab", "uiView" )) ) expect_equal(settings$countsOrPercents, "percent") settings$countsOrPercents <- "count" displaySettings(analysis) <- settings }) ds <- refresh(ds) deck <- decks(ds)[["new_name"]] test_that("query setting", { # establish that we have three slides, and their queries expect_equal(length(slides(deck)), 3) expect_identical(cube(deck[[1]]), crtabs(~v1, ds)) expect_identical(cube(deck[[2]]), crtabs(~v3, ds)) expect_identical(cube(deck[[3]]), crtabs(~v2, ds)) # change queries query(deck[[1]]) <- ~v3 query(analysis(deck[[2]])) <- ~v4 # make sure that the slides are all the same (except the one we replaced) deck <- refresh(deck) expect_equal(length(slides(deck)), 3) expect_identical(cube(deck[[1]]), crtabs(~v3, ds)) expect_identical(cube(deck[[2]]), crtabs(~v4, ds)) expect_identical(cube(deck[[3]]), crtabs(~v2, ds)) }) test_that("Filter setting", { ds <- refresh(ds) deck <- decks(ds)[["new_name"]] # establish that we have three slides, and their queries expect_equal(length(slides(deck)), 3) expect_identical(cube(deck[[1]]), crtabs(~v3, ds)) expect_identical(cube(deck[[2]]), crtabs(~v4, ds)) expect_identical(cube(deck[[3]]), crtabs(~v2, ds)) # make a named filter filters(ds)[["v4 is B"]] <- ds$v4 == "B" filters(ds)[["v1 over 0"]] <- ds$v1 > 0 # add filters filters(deck[[1]]) <- filters(ds)[["v4 is B"]] filters(analysis(deck[[2]])) <- filters(ds)[["v1 over 0"]] # check filters expect_identical(filters(deck[[1]]), list(filters(ds)[["v4 is B"]])) expect_identical(filters(analysis(deck[[2]])), list(filters(ds)[["v1 over 0"]])) # remove filters filters(deck[[1]]) <- NULL filters(analysis(deck[[2]])) <- NULL # make sure that the slides are still all the same deck <- refresh(deck) expect_equal(length(slides(deck)), 3) expect_identical(cube(deck[[1]]), crtabs(~v3, ds)) expect_identical(cube(deck[[2]]), crtabs(~v4, ds)) expect_identical(cube(deck[[3]]), crtabs(~v2, ds)) }) test_that("Weight setting", { ds <- refresh(ds) deck <- decks(ds)[["new_name"]] # establish that we have three slides, and their queries expect_equal(length(slides(deck)), 3) expect_identical(cube(deck[[1]]), crtabs(~v3, ds)) expect_identical(cube(deck[[2]]), crtabs(~v4, ds)) expect_identical(cube(deck[[3]]), crtabs(~v2, ds)) # make a weight variable ds$weight <- sample(c(.2, .8), 20, replace = TRUE) is.weightVariable(ds$weight) <- TRUE # add weights weight(deck[[1]]) <- ds$weight # check weights expect_identical(weight(deck[[1]]), ds$weight) # remove weights weight(deck[[1]]) <- NULL # make sure that the slides are still all the same deck <- refresh(deck) expect_equal(length(slides(deck)), 3) expect_identical(cube(deck[[1]]), crtabs(~v3, ds)) expect_identical(cube(deck[[2]]), crtabs(~v4, ds)) expect_identical(cube(deck[[3]]), crtabs(~v2, ds)) }) })