tests/testthat/test-cube-dims.R

In crunch: Crunch.io Data Tools

context("Cube dimensions")

test_that("getDimTypes returns the expected cube dimension types", {
    ca_mr <- loadCube(test_path("cubes/catarray-x-mr.json"))
    expect_equivalent(
        getDimTypes(ca_mr),
        c("ca_items", "ca_categories", "mr_items", "mr_selections")
    )
    cat_cat <- loadCube(test_path("cubes/cat-x-cat.json"))
    expect_equivalent(getDimTypes(cat_cat), c("categorical", "categorical"))
    ca <- loadCube(test_path("cubes/cat-array.json"))
    expect_equivalent(getDimTypes(ca), c("ca_items", "ca_categories"))
    cat_mr_mr <- loadCube(test_path("cubes/cat-x-mr-x-mr.json"))
    expect_equivalent(
        getDimTypes(cat_mr_mr),
        c(
            "categorical", "mr_items", "mr_selections", "mr_items",
            "mr_selections"
        )
    )
    cattarray_cat <- loadCube(test_path("cubes/catarray-x-cat.json"))
    expect_equivalent(
        getDimTypes(cattarray_cat),
        c("ca_items", "ca_categories", "categorical")
    )
    numa <- loadCube(test_path("cubes/numa.json"))
    expect_equivalent(
        getDimTypes(numa),
        c("numarray_items")
    )
    numa_cat <- loadCube(test_path("cubes/numa-x-cat.json"))
    expect_equivalent(
        getDimTypes(numa_cat),
        c("categorical", "numarray_items")
    )
    numa_mr <- loadCube(test_path("cubes/numa-x-mr.json"))
    expect_equivalent(
        getDimTypes(numa_mr),
        c("mr_items", "mr_selections", "numarray_items")
    )
})

with_mock_crunch({
    ## Load a ton of cube fixtures via the tab book feature
    ds <- cachedLoadDataset("test ds")
    m <- multitables(ds)[[1]]
    with_POST("https://app.crunch.io/api/datasets/1/multitables/apidocs-tabbook/", {
        book <- tabBook(m, data = ds)
    })
    cube <- book[[2]][[2]]
    d <- dimensions(cube)
    test_that("Dimensions of a cube", {
        expect_is(d, "CubeDims")
    })
    test_that("Dimnames", {
        expect_identical(
            dimnames(d),
            list(
                q1 = c("Cat", "Dog", "Bird", "Skipped", "Not Asked"),
                allpets = c("Cat", "Dog", "Bird")
            )
        )
        expect_identical(names(dimnames(d)), c("q1", "allpets"))
    })
    test_that("Additional variable attributes on CubeDims", {
        expect_identical(names(variables(d)), c("Pet", "All pets owned"))
        expect_identical(aliases(variables(d)), c("q1", "allpets"))
        expect_identical(
            descriptions(variables(d)),
            c(
                "What is your favorite pet?",
                "Do you have any of these animals as pets? Please select all that apply."
            )
        )
        expect_identical(
            types(variables(d)),
            c("categorical", "subvariable_items")
        )
    })
    test_that("Getting those additional variable attributes from the cube", {
        expect_identical(names(cube), c("Pet", "All pets owned"))
        expect_identical(aliases(cube), c("q1", "allpets"))
        expect_identical(
            descriptions(cube),
            c(
                "What is your favorite pet?",
                "Do you have any of these animals as pets? Please select all that apply."
            )
        )
        expect_identical(
            types(cube),
            c("categorical", "subvariable_items")
        )
        expect_identical(
            notes(cube),
            c("", "")
        )
    })
    test_that("Getting those attributes from MultitableResult (the column variables)", {
        expect_identical(names(book[[1]]), c("Total", "All pets owned", "Pet"))
        expect_identical(aliases(book[[1]]), c("total", "allpets", "q1"))
        expect_identical(
            descriptions(book[[1]]),
            c(
                "",
                "Do you have any of these animals as pets? Please select all that apply.",
                "What is your favorite pet?"
            )
        )
    })
    test_that("Getting those attributes from TabBookResult (the row/sheet variables)", {
        expect_identical(
            names(book)[2:4],
            c("Pet", "Pets by location", "Number of dogs")
        )
        expect_identical(aliases(book)[2:4], c("q1", "petloc", "ndogs"))
        expect_identical(
            descriptions(book)[2:4],
            c(
                "What is your favorite pet?",
                "Name the kinds of pets you have at these locations.",
                ""
            )
        )
    })

    test_that("Variable metadata retrieved from tuples works on the tuples ", {
        expect_identical(name(ds$gender), "Gender")
        expect_identical(description(ds$starttime), "Interview Start Time")
        expect_identical(alias(ds$gender), "gender")
        expect_identical(id(ds$gender), "66ae9881e3524f7db84970d556c34552")
        expect_identical(notes(ds$gender), "")
        expect_identical(notes(ds$birthyr), "Asked instead of age")
        expect_false(uniformBasis(ds$mymrset))
    })

    test_that("Variable metadata from cubes works on the tuples", {
        catarray_x_mr <- loadCube(test_path("cubes/catarray-x-mr.json"))
        cat_array_var <- variables(catarray_x_mr)[[1]]
        mr_var <- variables(catarray_x_mr)[[3]]

        expect_identical(name(cat_array_var), "feeling CA")
        expect_identical(alias(cat_array_var), "feeling_ca")
        expect_identical(description(cat_array_var), "")
        expect_identical(notes(cat_array_var), "")

        expect_equal(
            aliases(subvariables(cat_array_var)),
            c("cat_feeling", "dog_feeling")
        )
        expect_equal(
            names(subvariables(cat_array_var)),
            c("cat_feeling", "dog_feeling")
        )

        mr_var <- variables(catarray_x_mr)[[3]]
        expect_equal(
            aliases(subvariables(mr_var)),
            c("food_opinion__1", "rest_opinion__1", "play_opinion__1")
        )
        expect_equal(
            names(subvariables(mr_var)),
            c("food_opinion", "rest_opinion", "play_opinion")
        )
    })

    test_that("'measures' metadata", {
        expect_identical(
            names(measures(crtabs(max(birthyr) ~ 1, data = ds))),
            "Birth Year"
        )
        expect_identical(
            names(variables(crtabs(max(birthyr) ~ 1, data = ds))),
            "Birth Year"
        )
        expect_length(measures(crtabs(~ gender + textVar, data = ds)), 0)
        expect_identical(
            names(variables(crtabs(~ gender + textVar, data = ds))),
            c("Gender", "Text variable ftw")
        )
        skip("'mean' doesn't return variable metadata like 'max' does")
        expect_identical(
            names(measures(crtabs(mean(birthyr) ~ gender + textVar, data = ds))),
            "Birth Year"
        )
        expect_identical(
            names(variables(crtabs(mean(birthyr) ~ gender + textVar, data = ds))),
            c("Gender", "Text variable ftw", "Birth Year")
        )
        expect_identical(
            names(measures(
                crtabs(list(mean(birthyr), max(birthyr)) ~ gender + textVar, data = ds)
            )),
            c("Birth Year", "Birth Year")
        )
        expect_identical(
            names(variables(
                crtabs(list(mean(birthyr), max(birthyr)) ~ gender + textVar, data = ds)
            )),
            c("Gender", "Text variable ftw", "Birth Year")
        ) ## De-duped
        expect_identical(
            names(measures(
                crtabs(list(mean(birthyr), max(starttime)) ~ gender + textVar, data = ds)
            )),
            c("Interview Start Time", "Birth Year")
        ) ## Order in the JSON is reversed
        expect_identical(
            names(variables(
                crtabs(list(mean(birthyr), max(starttime)) ~ gender + textVar, data = ds)
            )),
            c("Gender", "Text variable ftw", "Interview Start Time", "Birth Year")
        )
    })
})

with_test_authentication({
    ds <- newDataset(data.frame(x = c(LETTERS[1:10])), name = "test for notes")

    test_that("empty variable description are empty string", {
        expect_equal(description(ds$x), "")
        expect_equal(notes(ds$x), "")
    })

    test_that("empty variable description are empty string in a cube too", {
        cube <- crtabs(~x, ds)
        expect_equal(descriptions(variables(cube)), description(ds$x))
        expect_equal(notes(variables(cube)), notes(ds$x))
    })
})