tests/testthat/test-expressions.R

In crunch: Crunch.io Data Tools

context("Expressions")

# Skip tests on windows (because they're slow and CRAN complains)
if (tolower(Sys.info()[["sysname"]]) != "windows") {
    test_that(".dispatchFilter uses right numeric function", {
        ## Use expect_prints because toJSON returns class "json" but prints correctly
        expect_prints(
            toJSON(.dispatchFilter(5)),
            paste0(
                '{"function":"==","args":[{"function":"row",',
                '"args":[]},{"value":4}]}'
            )
        )
        expect_prints(
            toJSON(.dispatchFilter(c(5, 7))),
            paste0(
                '{"function":"in","args":[{"function":"row",',
                '"args":[]},{"column":[4,6]}]}'
            )
        )
        expect_prints(
            toJSON(.dispatchFilter(5:7)),
            paste0(
                '{"function":"between","args":[{"function":"row",',
                '"args":[]},{"value":4},',
                '{"value":6},{"value":[true,true]}]}'
            )
        )
    })

    with_mock_crunch({
        ds <- cachedLoadDataset("test ds")

        test_that("is method works for both expressions and logical expressions", {
            expect_true(is.CrunchExpr(ds$birthyr + 5))
            expect_true(is.CrunchExpr(ds$birthyr == 5))
        })


        test_that("Arithmetic generates expressions", {
            e1 <- ds$birthyr + 5
            expect_is(e1, "CrunchExpr")
            zexp <- list(
                `function` = "+",
                args = list(
                    list(variable = "https://app.crunch.io/api/datasets/1/variables/birthyr/"),
                    list(value = 5)
                )
            )
            expect_equivalent(zcl(e1), zexp)
            expect_prints(e1, "Crunch expression: birthyr + 5")
            e2 <- 5 + ds$birthyr
            expect_is(e2, "CrunchExpr")
            expect_prints(e2, "Crunch expression: 5 + birthyr")
        })

        test_that("Integer printing removes L", {
            e1 <- ds$birthyr + 1L
            expect_is(e1, "CrunchExpr")
            expect_prints(e1, "Crunch expression: birthyr + 1")
        })

        test_that("Logic generates expressions", {
            e1 <- ds$birthyr < 0
            expect_is(e1, "CrunchLogicalExpr")
            expect_prints(e1, "Crunch logical expression: birthyr < 0")
        })

        test_that("R logical & CrunchLogicalExpr", {
            expect_is(
                c(TRUE, FALSE, TRUE) & ds$gender == "Female",
                "CrunchLogicalExpr"
            )
            expect_is(
                c(TRUE, FALSE, TRUE) | ds$gender == "Female",
                "CrunchLogicalExpr"
            )
            expect_is(
                ds$gender == "Female" & c(TRUE, FALSE, TRUE),
                "CrunchLogicalExpr"
            )
            expect_is(
                ds$gender == "Female" | c(TRUE, FALSE, TRUE),
                "CrunchLogicalExpr"
            )
        })

        test_that("Datetime operations: logical", {
            expect_prints(
                ds$starttime == "2015-01-01",
                'Crunch logical expression: starttime == "2015-01-01"'
            )
            expect_prints(
                ds$starttime > "2015-01-01",
                'Crunch logical expression: starttime > "2015-01-01"'
            )
            expect_prints(
                ds$starttime == as.Date("2015-01-01"),
                'Crunch logical expression: starttime == "2015-01-01"'
            )
            expect_prints(
                ds$starttime > as.Date("2015-01-01"),
                'Crunch logical expression: starttime > "2015-01-01"'
            )
        })

        test_that("Logical expr with categoricals", {
            expect_is(ds$gender == "Male", "CrunchLogicalExpr")
            expect_prints(
                ds$gender == "Male",
                'Crunch logical expression: gender == "Male"'
            )
            expect_prints(
                ds$gender == as.factor("Male"),
                'Crunch logical expression: gender == "Male"'
            )
            expect_prints(
                ds$gender %in% "Male",
                'Crunch logical expression: gender %in% "Male"'
            )
            expect_prints(
                ds$gender %in% as.factor("Male"),
                'Crunch logical expression: gender %in% "Male"'
            )
            expect_prints(
                ds$gender %in% c("Male", "Female"),
                'Crunch logical expression: gender %in% c("Male", "Female")'
            )
            expect_prints(
                ds$gender %in% as.factor(c("Male", "Female")),
                'Crunch logical expression: gender %in% c("Male", "Female")'
            )
            expect_prints(
                ds$gender != "Female",
                'Crunch logical expression: gender != "Female"'
            )
            expect_prints(
                ds$gender != as.factor("Female"),
                'Crunch logical expression: gender != "Female"'
            )
        })
        test_that("Referencing category names that don't exist warns and drops", {
            expect_warning(
                expect_prints(
                    ds$gender == "other",
                    "Crunch logical expression: gender %in% character(0)"
                ),
                paste("Category not found:", dQuote("other"))
            )
            expect_warning(
                expect_prints(
                    ds$gender %in% c("other", "Male", "another"),
                    'Crunch logical expression: gender %in% "Male"'
                ),
                paste(
                    "Categories not found:", dQuote("other"), "and",
                    dQuote("another")
                )
            )
            expect_warning(
                expect_prints(
                    ds$gender != "other",
                    "Crunch logical expression: !gender %in% character(0)"
                ),
                paste("Category not found:", dQuote("other"))
            )
        })

        test_that("Show method for logical expressions", {
            expect_prints(
                ds$gender %in% c("Male", "Female"),
                'Crunch logical expression: gender %in% c("Male", "Female"'
            )
            expect_prints(
                ds$gender %in% 1:2,
                'Crunch logical expression: gender %in% c("Male", "Female"'
            )
            expect_prints(
                ds$birthyr == 1945 | ds$birthyr < 1941,
                "birthyr == 1945 | birthyr < 1941"
            )
            expect_prints(
                ds$gender %in% "Male" & !is.na(ds$birthyr),
                'gender %in% "Male" & !is.na(birthyr)'
            )
            expect_prints(
                !(ds$gender == "Male"),
                'Crunch logical expression: !gender == "Male"'
            )
            ## TODO: better parentheses for ^^
            expect_prints(
                duplicated(ds$gender),
                "Crunch logical expression: duplicated(gender)"
            )
            expect_prints(
                duplicated(ds$gender == "Male"),
                'Crunch logical expression: duplicated(gender == "Male")'
            )
        })

        test_that("Can subset a CrunchExpr with R values", {
            age <- 2016 - ds$birthyr
            ## Note: no check for correct number of rows
            expect_is(age[c(TRUE, FALSE, TRUE)], "CrunchExpr")
            expect_prints(
                toJSON(activeFilter(age[c(TRUE, FALSE, TRUE)])),
                paste0(
                    '{"function":"in","args":[{"function":"row",',
                    '"args":[]},{"column":[0,2]}]}'
                )
            )
            expect_is(age[c(1, 3)], "CrunchExpr")
            expect_prints(
                toJSON(activeFilter(age[c(1, 3)])),
                paste0(
                    '{"function":"in","args":[{"function":"row",',
                    '"args":[]},{"column":[0,2]}]}'
                )
            )
        })

        test_that("Show method for expresssions", {
            skip("TODO: something intelligent with parentheses and order of operations (GH issue #99)")
            print(ds$birthyr * 3 + 5)
            print(3 * (ds$birthyr + 5))
        })

        test_that("as.vector for 3VL CrunchLogicalExpr returns R logical", {
            vals <- as.vector(ds$birthyr == 1945 | ds$birthyr < 1941)
            expect_true(is.logical(vals))
            expect_equal(which(ds$birthyr == 1945 | ds$birthyr < 1941), 4:20)
        })

        test_that("crunchDifftime expr", {
            expr <- crunchDifftime(ds$starttime, ds$starttime)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"difftime","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/starttime/"},', #nolint
                    '{"variable":"https://app.crunch.io/api/datasets/1/variables/starttime/"},null]}'
                )
            )

            expect_error(
                crunchDifftime(ds$gender, ds$gender),
                "variable must be of type 'Datetime' for crunchDifftime"
            )
        })

        test_that("datetimeFromCols expr", {
            expr <- datetimeFromCols(ds$birthyr, ds$birthyr, ds$birthyr)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"datetime","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},', #nolint
                    '{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},',
                    '{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},null,null,null]}' #nolint
                )
            )

            expect_error(
                datetimeFromCols(ds$gender, ds$gender, ds$gender),
                "variable must be of type 'Numeric' for datetimeFromCols"
            )
        })

        test_that("%ornm% expr", {
            expr <- (ds$birthyr == 1945) %ornm% (ds$birthyr < 1941)
            expect_is(expr, "CrunchLogicalExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"ornm","args":[{"function":"==","args":',
                    '[{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},',
                    '{"value":1945}]},{"function":"<","args":[{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/birthyr/"},{"value":1941}]}]}'
                )
            )
        })

        test_that("is.valid expr", {
            expr <- is.valid(ds$birthyr)
            expect_is(expr, "CrunchLogicalExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"is_valid","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"}]}' #nolint
                )
            )
        })

        test_that("makeFrame categorical vars exoression", {
            expr <- makeFrame(ds[c("gender", "location")])
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"array","args":[{"function":"make_frame","args":[{"map":{"0001":{"variable":', # nolint
                    '"https://app.crunch.io/api/datasets/1/variables/gender/"},"0002":{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/location/"}}},{"value":',
                    '["0001","0002"]}]}],"kwargs":{"numeric":{"value":false}}}'
                )
            )
        })

        test_that("makeFrame numeric vars expression", {
            expr <- makeFrame(ds[c("birthyr")])
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"array","args":[{"function":"make_frame","args":[{"map":{"0001":{"variable":', # nolint
                    '"https://app.crunch.io/api/datasets/1/variables/birthyr/"}}},{"value":',
                    '["0001"]}]}],"kwargs":{"numeric":{"value":true}}}'
                )
            )
        })

        test_that("makeFrame from expressions expression works", {
            expect_json_equivalent(
                makeFrame(
                    list(VariableDefinition(ds$gender == "Male", name = "male")),
                    numeric = FALSE
                )@expression,
                list(
                    `function` = "array",
                    args = list(list(
                        `function` = "make_frame",
                        args = list(list(
                            map = list(
                                c(zcl(ds$gender == "Male"), list(references = list(name = "male")))
                            )
                        ), list(value = I("0001")))
                    )),
                    kwargs = list(numeric = list(value = FALSE))
                )
            )
        })

        test_that("makeFrame from expressions expression requires numeric arg", {
            expect_error(
                deriveArray(
                    subvariables = list(VariableDefinition(ds$gender == "Male", name = "male")),
                    name = "Gender MR"
                ),
                "Could not guess array type, specify `numeric` argument in `makeFrame()`",
                fixed = TRUE
            )
        })

        test_that("makeFrame type checks numeric arg", {
            expect_error(
                deriveArray(
                    subvariables = list(VariableDefinition(ds$gender == "Male", name = "male")),
                    name = "Gender MR",
                    numeric = "WRONG"
                ),
                "Expected `numeric` argument of `makeFrame()` to be TRUE or FALSE",
                fixed = TRUE
            )
        })

        test_that("makeFrame errors on single subvar", {
            expect_error(
                deriveArray(
                    subvariables = VariableDefinition(ds$gender == "Male", name = "male"),
                    name = "Gender MR"
                ),
                "Expected a Variable Catalog or a list of Variables/Expressions/VarDefs",
                fixed = TRUE
            )

        })

        test_that("selectCategories expr", {
            expr <- selectCategories(ds$gender, "Male")
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"as_selected","args":[{"function":"select_categories","args":',
                    '[{"variable":"https://app.crunch.io/api/datasets/1/variables/gender/"},',
                    '{"value":["Male"]}]}]}'
                )
            )
        })

        test_that("crunchBetween expr", {
            expr <- crunchBetween(ds$birthyr, 3, 5)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"between","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},', # nolint
                    '{"value":3},{"value":5},{"value":[true,false]}]}'
                )
            )
            expect_error(
                crunchBetween(ds$gender, 3, 5),
                "variable must be of type 'Numeric' for crunchBetween"
            )
        })

        test_that("rowAll expr", {
            expr <- rowAll(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"all","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )

            expect_error(rowAll(ds$gender), "variable must be of type 'Array' for rowAll")
        })

        test_that("rowAny expr", {
            expr <- rowAny(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"any","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )

            expect_error(rowAny(ds$birthyr), "variable must be of type 'Array' for rowAny")
        })


        test_that("rowAnyNA expr", {
            expr <- rowAnyNA(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"any_missing","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )
            expect_error(rowAnyNA(ds$gender), "variable must be of type 'Array' for rowAnyNA")
        })

        test_that("rowAllNA expr", {
            expr <- rowAllNA(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"all_missing","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )
            expect_error(rowAllNA(ds$gender), "variable must be of type 'Array' for rowAllNA")
        })

        test_that("complete.cases expr", {
            expr <- complete.cases(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"complete_cases","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )

            expect_error(
                complete.cases(ds$gender),
                "variable must be of type 'Array' for complete.cases"
            )
        })

        test_that("is.selected expr", {
            expr <- is.selected(ds$gender)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"selected","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/gender/"}]}' # nolint
                )
            )
            expect_error(
                is.selected(ds$birthyr),
                "variable must be of type 'Categorical' for is.selected"
            )
        })

        test_that("asSelected expr", {
            expr <- asSelected(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"as_selected","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )

            expect_error(
                asSelected(ds$birthyr),
                paste0(
                    "variable must be of type 'Categorical', 'Categorical Array', ",
                    "'Multiple Response' for asSelected"
                )
            )
        })

        test_that("selectedDepth expr", {
            expr <- selectedDepth(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"selected_depth","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )

            expect_error(
                selectedDepth(ds$gender),
                "variable must be of type 'Multiple Response' for selectedDepth"
            )
        })

        test_that("arraySelections expr", {
            expr <- arraySelections(ds$mymrset)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"selections","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/mymrset/"}]}' # nolint
                )
            )

            expect_error(
                arraySelections(ds$gender),
                "variable must be of type 'Multiple Response' for arraySelections"
            )
        })

        test_that("nchar expr", {
            expr <- nchar(ds$textVar)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"char_length","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/textVar/"}]}' # nolint
                )
            )

            expect_error(nchar(ds$gender), "variable must be of type 'Text' for nchar")
        })

        test_that("trim expr", {
            expr <- trim(ds$birthyr, 1950, 2000)
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"trim","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},', # nolint
                    '{"value":1950},{"value":2000}]}'
                )
            )

            expect_error(trim(ds$gender), "variable must be of type 'Numeric' for trim")
        })

        test_that("alterCategoriesExpr - var: ids", {
            expr <- alterCategoriesExpr(
                ds$catarray,
                list(list(id = 1, name = "AAA")),
                c(2, 1, -1),
                list(list(id = "subvar1", name = "ZZZ"))
            )
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_categories","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/catarray/"}],', # nolint
                    '"kwargs":{"categories":{"value":[{"id":1,"name":"AAA"}]},"order":{"value":[2,1,-1]},', #nolint
                    '"subvariables":{"value":[{"id":"subvar1","name":"ZZZ"}]}}}'
                )
            )
        })

        test_that("alterCategoriesExpr - var: names", {
            expr <- alterCategoriesExpr(
                ds$catarray,
                list(list(old_name = "A", name = "AAA")),
                c("B", "A", "No Data"),
                list(list(old_name = "Second", name = "ZZZ"))
            )
            expect_is(expr, "CrunchExpr")

            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_categories","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/catarray/"}],', # nolint
                    '"kwargs":{"categories":{"value":[{"id":1,"name":"AAA"}]},"order":{"value":[2,1,-1]},', #nolint
                    '"subvariables":{"value":[{"id":"subvar1","name":"ZZZ"}]}}}'
                )
            )
        })

        test_that("alterCategoriesExpr - var: subvar alias", {
            expr <- alterCategoriesExpr(
                ds$catarray,
                subvariables = list(list(alias = "subvar1", name = "ZZZ"))
            )
            expect_is(expr, "CrunchExpr")

            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_categories","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/catarray/"}],', # nolint
                    '"kwargs":{"subvariables":{"value":[{"id":"subvar1","name":"ZZZ"}]}}}'
                )
            )
        })

        test_that("alterCategoriesExpr - expr: ids", {
            expr <- alterCategoriesExpr(
                selectCategories(ds$catarray, "A"),
                list(list(id = 1, name = "AAA")),
                c(2, 1, -1),
                list(list(id = "subvar1", name = "ZZZ"))
            )
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_categories","args":[{"function":"as_selected","args":',
                    '[{"function":"select_categories","args":',
                    '[{"variable":"https://app.crunch.io/api/datasets/1/variables/catarray/"},',
                    '{"value":["A"]}]}]}],"kwargs":{',
                    '"categories":{"value":[{"id":1,"name":"AAA"}]},"order":{"value":[2,1,-1]},',
                    '"subvariables":{"value":[{"id":"subvar1","name":"ZZZ"}]}}}'
                )
            )
        })

        test_that("alterCategoriesExpr - expr: names (failures)", {
            # Wrong var type
            expect_error(
                alterCategoriesExpr(ds$birthyr, list(list(id = 1, name = "AAA"))),
                "variable must be of type 'Array', 'Categorical' for alterCategoriesExpr"
            )

            # Rely on names when have an expression
            expect_error(
                alterCategoriesExpr(
                    selectCategories(ds$catarray, "A"),
                    categories = list(list(old_name = "A", name = "AAA"))
                ),
                "Must use category ids when modifying categories of an expression"
            )

            expect_error(
                alterCategoriesExpr(
                    selectCategories(ds$catarray, "A"),
                    category_order = c("B", "A", "No Data"),
                ),
                "Must use category ids when reordering categories of an expression"
            )

            expect_error(
                alterCategoriesExpr(
                    selectCategories(ds$catarray, "A"),
                    subvariables = list(list(old_name = "Second", name = "ZZZ"))
                ),
                "Must use subvariable ids when modifying subvariable names of an expression"
            )

            # bad category name modify
            expect_error(
                alterCategoriesExpr(
                    ds$catarray,
                    list(list(old_name = "XYZ", name = "AAA")),
                ),
                "Could not find category with old name 'XYZ'"
            )

            # bad category name reorder
            expect_error(
                alterCategoriesExpr(
                    ds$catarray,
                    category_order = c("XYZ", "A", "No Data"),
                ),
                "Categories 'XYZ' not found in data"
            )

            # bad subvariable name
            expect_error(
                alterCategoriesExpr(
                    ds$catarray,
                    subvariables = list(list(old_name = "XYZ", name = "ZZZ"))
                ),
                "Could not find subvariable with old name 'XYZ'"
            )
            # bad subvariable alias
            expect_error(
                alterCategoriesExpr(
                    ds$catarray,
                    subvariables = list(list(alias = "XYZ", name = "ZZZ"))
                ),
                "Could not find subvariable with alias 'XYZ'"
            )
        })


        test_that("alterArrayExpr - add var and order", {
            expr <- alterArrayExpr(
                ds$mymrset,
                add = list("4" = ds$gender),
                order = c("gender", "4", "subvar1", "subvar3"),
                order_id = "id"
            )
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_array","args":[{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/mymrset/"}],',
                    '"kwargs":{"add":{"map":{"4":{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/gender/"}}},',
                    '"order":{"value":["gender","4","subvar1","subvar3"]}}}'
                )
            )
        })

        test_that("alterArrayExpr - add var and order by new alias", {
            expr <- alterArrayExpr(
                ds$mymrset,
                add = list("4" = VarDef(alias = "new_gender", ds$gender)),
                order = c("subvar2", "new_gender", "subvar1", "subvar3")
            )
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_array","args":[{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/mymrset/"}],',
                    '"kwargs":{"add":{"map":{"4":{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/gender/",',
                    '"references":{"alias":"new_gender"}}}},',
                    '"order":{"value":["gender","4","subvar1","subvar3"]}}}'
                )
            )
        })

        test_that("alterArrayExpr - add var no order", {
            expr <- alterArrayExpr(
                ds$mymrset,
                add = list(ds$gender),
            )
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_array","args":[{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/mymrset/"}],',
                    '"kwargs":{"add":{"map":{"1":{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/gender/"}}},',
                    '"order":{"value":["gender","subvar1","subvar3","1"]}}}'
                )
            )
        })

        test_that("alterArrayExpr - remove var", {
            expr <- alterArrayExpr(
                ds$mymrset,
                remove = "gender",
                remove_id = "id"
            )
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_array","args":[{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/mymrset/"}],',
                    '"kwargs":{"remove":{"value":["gender"]}}}'
                )
            )

            expect_equal(
                unclass(toJSON(alterArrayExpr(ds$mymrset, remove = "subvar2", remove_id = "alias")@expression)), #nolint
                unclass(toJSON(expr@expression))
            )

            expect_equal(
                unclass(toJSON(alterArrayExpr(ds$mymrset, remove = "First", remove_id = "name")@expression)),  #nolint
                unclass(toJSON(expr@expression))
            )
        })

        test_that("alterArrayExpr - subreferences", {
            expr <- alterArrayExpr(
                ds$mymrset,
                subreferences = list("subvar2" = list(name = "new name"))
            )
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"alter_array","args":[{"variable":',
                    '"https://app.crunch.io/api/datasets/1/variables/mymrset/"}],',
                    '"kwargs":{"subreferences":{"value":{"gender":{"name":"new name"}}}}}'
                )
            )
        })

        test_that("arraySubsetExpr", {
            # aliases
            expr <- arraySubsetExpr(ds$catarray, c("subvar1", "subvar3"), "alias")
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"array_subset","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/catarray/"},', # nolint
                    '{"value":["subvar1","subvar3"]}]}'
                )
            )

            # names
            expr <- arraySubsetExpr(ds$catarray, c("Second", "Last"), "name")
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"array_subset","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/catarray/"},', # nolint
                    '{"value":["subvar1","subvar3"]}]}'
                )
            )

            # ids
            expr <- arraySubsetExpr(ds$catarray, c("subvar1", "subvar3"), "id")
            expect_is(expr, "CrunchExpr")
            expect_equal(
                unclass(toJSON(expr@expression)),
                paste0(
                    '{"function":"array_subset","args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/catarray/"},', # nolint
                    '{"value":["subvar1","subvar3"]}]}'
                )
            )

            # fail
            expect_error(
                arraySubsetExpr(ds$catarray, c("XYZ", "subvar3"), "alias"),
                "Could not find subvariables with alias 'XYZ'"
            )

            # fail
            expect_error(
                arraySubsetExpr(asSelected(ds$catarray), c("subvar1", "subvar2"), "alias"),
                "Must provide subvariable ids when x is an expression"
            )

            expect_error(
                arraySubsetExpr(ds$gender),
                "variable must be of type 'Array' for arraySubsetExpr"
            )
        })
    })

    with_test_authentication({
        ds <- newDataset(df)
        ds$q1 <- factor(rep(c("selected", "not selected"), 10))
        test_that("Arithmetic expressions evaluate", {
            e1 <- ds$v3 + 5
            expect_is(e1, "CrunchExpr")
            e2 <- 5 + ds$v3
            expect_is(e2, "CrunchExpr")
            expect_identical(as.vector(e1), as.vector(ds$v3) + 5)
            expect_identical(as.vector(e1), as.vector(e2))
            expect_identical(as.vector(ds$v3 * ds$v3), df$v3^2) # nolint
        })


        ds <- forceVariableCatalog(ds) # force variable catalog so we can count requests
        uncached({
            with_mock(`crunch::.crunchPageSize` = function(x) 5L, {
                with(temp.option(httpcache.log = ""), {
                    avlog <- capture.output(v35 <- as.vector(ds$v3 + 5))
                })
                test_that("as.vector with CrunchExpr is paginated", {
                    logdf <- loadLogfile(textConnection(avlog))
                    ## GET /values/ 4x
                    ## to get data, then a 5th GET /values/ that returns 0
                    ## values, which breaks the pagination loop
                    expect_identical(logdf$verb, rep("GET", 5))
                    expect_identical(grep("table", logdf$url), 1:5)
                })
                test_that("getValues returns the same result when paginated", {
                    expect_equivalent(v35, df$v3 + 5)
                })
            })
        })

        test_that("Logical expressions evaluate", {
            e1 <- ds$v3 > 10
            expect_is(e1, "CrunchLogicalExpr")
            expect_identical(as.vector(e1), df$v3 > 10)
            expect_identical(which(e1), which(df$v3 > 10))
        })

        test_that("Logical expressions with text variables evaluate", {
            e2 <- try(ds$v2 == "a")
            expect_is(e2, "CrunchLogicalExpr")
            na_filt <- !is.na(df$v2) # Crunch and R evaluate NA == "a" differently
            expect_identical(as.vector(e2)[na_filt], df[na_filt, ]$v2 == "a")
            expect_identical(which(e2), which(df$v2 == "a"))
        })

        test_that("R & Crunch logical together", {
            e1 <- ds$v3 < 10 | c(rep(FALSE, 15), rep(TRUE, 5))
            expect_equivalent(
                as.vector(ds$v3[e1]),
                c(8, 9, 23, 24, 25, 26, 27)
            )
            e2 <- TRUE & is.na(ds$v2)
            expect_equivalent(
                as.vector(ds$v3[e2]),
                23:27
            )
            e3 <- df$v4 == "B" & is.na(ds$v1) ## Note df
            expect_equivalent(
                as.vector(ds$v3[e3]),
                c(8, 10, 12)
            )
        })

        test_that("expressions on expressions evaluate", {
            e3 <- ds$v3 + ds$v3 + 10
            expect_is(e3, "CrunchExpr")
            expect_prints(e3, "Crunch expression: v3 + v3 + 10")
            expect_identical(as.vector(e3), 2 * df$v3 + 10)
            e4 <- ds$v3 + ds$v3 * 2
            expect_is(e4, "CrunchExpr")
            expect_prints(e4, "Crunch expression: v3 + v3 * 2")
            expect_identical(as.vector(e4), 3 * df$v3)
        })

        varnames <- names(df[-6])
        test_that("Select values with Numeric inequality filter", {
            e5 <- ds$v3[ds$v3 < 10]
            expect_is(e5, "CrunchVariable")
            expect_identical(as.vector(e5), c(8, 9))
            for (i in varnames) {
                expect_equivalent(as.vector(ds[[i]][ds$v3 < 10]),
                                  df[[i]][1:2],
                                  info = i
                )
            }
        })
        test_that("Select values with %in% on Numeric", {
            for (i in varnames) {
                expect_equivalent(as.vector(ds[[i]][ds$v3 %in% 10]),
                                  df[[i]][3],
                                  info = i
                )
                expect_equivalent(as.vector(ds[[i]][ds$v3 %in% c(10, 12)]),
                                  df[[i]][c(3, 5)],
                                  info = i
                )
            }
        })
        test_that("Select values with %in% on Categorical", {
            expect_length(as.vector(ds$v3[ds$v4 %in% "B"]), 10)
            for (i in varnames) {
                expect_equivalent(as.vector(ds[[i]][ds$v4 %in% "B"]),
                                  df[[i]][df$v4 %in% "B"],
                                  info = i
                )
            }
            expect_length(as.vector(ds$v3[ds$q1 %in% "selected"]), 10)
        })
        test_that("Select values with %in% on nonexistent categories", {
            expect_length(as.vector(ds$v3[ds$v4 %in% numeric(0)]), 0)
            expect_length(as.vector(ds$v3[!(ds$v4 %in% numeric(0))]), 20)
            expect_warning(
                expect_length(as.vector(ds$v3[ds$v4 == "other"]), 0),
                paste0("Category not found: ", dQuote("other"), ". Dropping.")
            )
            expect_warning(
                expect_length(as.vector(ds$v3[ds$v4 != "other"]), 20),
                paste0("Category not found: ", dQuote("other"), ". Dropping.")
            )
        })

        uncached({
            with_mock(`crunch::.crunchPageSize` = function(x) 5L, {
                with(temp.option(httpcache.log = ""), {
                    avlog <- capture.output(v3.5 <- as.vector(ds$v3[ds$v4 %in% "B"]))
                })
                test_that("Select values with %in% on Categorical, paginated", {
                    logdf <- loadLogfile(textConnection(avlog))
                    ## GET v3 entity to get /values/ URL,
                    ## GET v3 entity to get categories to construct expr,
                    ## GET /values/ 2x to get data,
                    ## then a 3rd GET /values/ that returns 0
                    ## values, which breaks the pagination loop
                    expect_identical(logdf$verb, rep("GET", 5))
                    expect_identical(grep("values", logdf$url), 3:5)
                    expect_equivalent(v3.5, df$v3[df$v4 %in% "B"])
                })
            })
        })
        test_that("Select values with &ed filter", {
            expect_equivalent(
                as.vector(ds$v3[ds$v3 >= 10 & ds$v3 < 13]),
                10:12
            )
            f <- ds$v3 >= 10 & ds$v3 < 13
            expect_is(f, "CrunchLogicalExpr")
            for (i in varnames) {
                expect_equivalent(as.vector(ds[[i]][f]),
                                  df[[i]][3:5],
                                  info = i
                )
            }
        })
        test_that("Select values with negated filter", {
            expect_equivalent(
                as.vector(ds$v3[!(ds$v4 %in% "B")]),
                df$v3[df$v4 %in% "C"]
            )
            for (i in varnames) {
                expect_equivalent(as.vector(ds[[i]][!(ds$v4 %in% "B")]),
                                  df[[i]][df$v4 %in% "C"],
                                  info = i
                )
            }
        })

        test_that("R numeric filter evaluates", {
            expect_equivalent(as.vector(ds$v3[6]), df$v3[6])
        })
        test_that("If R numeric filter is a range, 'between' is correct", {
            expect_equivalent(as.vector(ds$v3[3:18]), df$v3[3:18])
            # even if the range is reversed
            expect_equivalent(as.vector(ds$v3[18:3]), df$v3[3:18])
        })
        test_that("If R numeric filter has NAs there are no errors", {
            expect_equivalent(as.vector(ds$v3[c(1, NA, 2)]), df$v3[c(1, 2)])
            # even if the NAs are at the beginning or end
            expect_equivalent(as.vector(ds$v3[c(1, 2, NA)]), df$v3[c(1, 2)])
            expect_equivalent(as.vector(ds$v3[c(NA, 1, 2)]), df$v3[c(1, 2)])
        })
        test_that("R logical filter evaluates", {
            expect_identical(as.vector(ds$v3[df$v3 < 10]), c(8, 9))
        })

        test_that("filtered categorical returns factor", {
            expect_equivalent(
                as.vector(ds$v4[ds$v4 == "B"]),
                factor(rep("B", 10))
            )
        })

        test_that("duplicated method", {
            expect_identical(which(duplicated(ds$v3)), integer(0))
            expect_equivalent(as.vector(ds$v3[duplicated(ds$v4)]), 10:27)
            expect_identical(which(duplicated(ds$v3 + 4)), integer(0))
            expect_identical(which(duplicated(ds$v4)), 3:20)
        })

        test_that("rollupResolution can be set", {
            expect_null(rollupResolution(ds$v5))
            rollupResolution(ds$v5) <- "M"
            expect_identical(rollupResolution(ds$v5), "M")
        })
    })
}