tests/testthat/test-case-when-variable.R

In crunch: Crunch.io Data Tools

context("caseWhen variable")

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

    test_that("caseWhenExpr works when single rhs variable", {
        expect_equal(
            unclass(toJSON(
                caseWhenExpr(ds$birthyr > 1970 ~ ds$gender)@expression
            )),
            paste0(
                '{"function":"fill","args":[{"function":"case","args":[{"column":[1],"type":{',
                '"value":{"class":"categorical","categories":[',
                '{"id":1,"name":"casefill__internal1","numeric_value":null,"missing":false}',
                ']}}},{"function":">","args":[{"variable"',
                ':"https://app.crunch.io/api/datasets/1/variables/birthyr/"},{"value":1970}]}]}',
                ',{"map":{"1":{"variable":"https://app.crunch.io/api/datasets/1/variables/gender/"}}}]}' # nolint
            )
        )
    })

    test_that("caseWhenExpr works when single rhs Category", {
        expect_equal(
            unclass(toJSON(
                caseWhenExpr(ds$birthyr > 1970 ~ Category(name = "Hello"))@expression
            )),
            paste0(
                '{"function":"case","args":[{"column":[1],"type":{"value":{"class":"categorical",',
                '"categories":[{"id":1,"name":"Hello","numeric_value":null,"missing":false}]}}},',
                '{"function":">","args":[{"variable":',
                '"https://app.crunch.io/api/datasets/1/variables/birthyr/"},{"value":1970}]}]}'
            )
        )
    })

    test_that("caseWhenExpr works when variable + rhs string + else statement", {
        expect_equal(
            unclass(toJSON(
                caseWhenExpr(
                    crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                    crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                    TRUE ~ Category(name = "Missed Q", missing = TRUE)
                )@expression
            )),
            paste0(
                '{"function":"fill","args":[{"function":"case","args":[{"column":[1,2,3],',
                '"type":{"value":{"class":"categorical","categories":[{"id":1,"name":"Hello",',
                '"numeric_value":null,"missing":false},{"id":2,"name":"casefill__internal2",',
                '"numeric_value":null,"missing":false},{"id":3,"name":"Missed Q",',
                '"numeric_value":null,"missing":true}]}}},{"function":"between","args"',
                ':[{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},',
                '{"value":1970},{"value":1980},{"value":[true,false]}]},{"function":"between",',
                '"args":[{"variable":"https://app.crunch.io/api/datasets/1/variables/birthyr/"},',
                '{"value":1980},{"value":1990},{"value":[true,false]}]}]},{"map":{"2":{"variable":',
                '"https://app.crunch.io/api/datasets/1/variables/gender/"}}}]}'
            )
        )
    })

    test_that("caseWhenExpr works with numbers in rhs", {
        expect_equal(
            unclass(toJSON(
                caseWhenExpr(ds$birthyr < 1970 ~ 1970)@expression
            )),
            paste0(
                '{"function":"numeric_fill","args":[{"function":"case","args":[{"column":[1],"type":{', #nolint
                '"value":{"class":"categorical","categories":[',
                '{"id":1,"name":"casefill__internal1","numeric_value":null,"missing":false}',
                ']}}},{"function":"<","args":[{"variable"',
                ':"https://app.crunch.io/api/datasets/1/variables/birthyr/"},{"value":1970}]}]}',
                ',{"map":{"1":{"value":1970,"type":"numeric"}}}]}'
            )
        )
    })

    test_that("caseWhenExpr handles formulas in cases argument", {
        expect_equal(
            caseWhenExpr(
                crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                TRUE ~ Category(name = "Missed Q", missing = TRUE)
            ),
            caseWhenExpr(
                cases = list(
                    crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                    crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                    TRUE ~ Category(name = "Missed Q", missing = TRUE)
                )
            )
        )
    })

    test_that("caseWhenExpr handles lists in cases argument", {
        expect_equal(
            caseWhenExpr(
                crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                TRUE ~ Category(name = "Missed Q", missing = TRUE)
            ),
            caseWhenExpr(
                cases = list(
                    list(
                        expression = crunchBetween(ds$birthyr, 1970, 1980),
                        name = "Hello"
                    ),
                    list(
                        expression = crunchBetween(ds$birthyr, 1980, 1990),
                        fill = ds$gender
                    ),
                    list(
                        expression = TRUE,
                        name = "Missed Q",
                        missing = TRUE
                    )
                )
            )
        )
    })

    test_that("caseWhenExpr handles data argument", {
        expect_equal(
            caseWhenExpr(
                crunchBetween(birthyr, 1970, 1980) ~ Category(name = "Hello"),
                crunchBetween(birthyr, 1980, 1990) ~ gender,
                TRUE ~ Category(name = "Missed Q", missing = TRUE),
                data = ds
            ),
            caseWhenExpr(
                crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                TRUE ~ Category(name = "Missed Q", missing = TRUE)
            )
        )
    })

    test_that("makeCaseWhenVariable handles data argument", {
        expect_equal(
            makeCaseWhenVariable(
                crunchBetween(birthyr, 1970, 1980) ~ Category(name = "Hello"),
                crunchBetween(birthyr, 1980, 1990) ~ gender,
                TRUE ~ Category(name = "Missed Q", missing = TRUE),
                data = ds,
                name = "test"
            ),
            makeCaseWhenVariable(
                crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                TRUE ~ Category(name = "Missed Q", missing = TRUE),
                name = "test"
            )
        )
    })

    test_that("makeCaseWhenVariable correctly separates dots", {
        expect_equal(
            makeCaseWhenVariable(
                crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                TRUE ~ Category(name = "Missed Q", missing = TRUE),
                name = "test",
                description = "desc"
            ),
            VarDef(
                caseWhenExpr(
                    crunchBetween(ds$birthyr, 1970, 1980) ~ Category(name = "Hello"),
                    crunchBetween(ds$birthyr, 1980, 1990) ~ ds$gender,
                    TRUE ~ Category(name = "Missed Q", missing = TRUE)
                ),
                name = "test",
                description = "desc"
            )
        )
    })


    test_that("caseWhenExpr formula validations", {
        expect_error(
            makeCaseWhenVariable(~ds$gender),
            "The condition provided must be a proper formula: .ds.gender"
        )

        expect_error(
            makeCaseWhenVariable(ds$gender ~ ds$gender),
            "The left-hand side provided must be a logical or a CrunchLogicalExpr:"
        )

        expect_error(
            makeCaseWhenVariable(ds$birthyr > 1980 ~ list(x = 1)),
            paste0(
                "The right-hand side provided must be a Category, CrunchVariable ",
                "string, number, or `NA`:"
            )
        )
    })
})

with_test_authentication({
    ds <- newDataset(
        data.frame(
            fav_brand1 = factor(
                c("Coke", "Diet Coke", "Diet Pepsi", "Coke", "Pepsi", "Water"),
                c("Coke", "Diet Coke", "Pepsi", "Diet Pepsi", "Water")
            ),
            fav_brand2 = factor(
                c("Diet Coke", "Pepsi", "Coke", "Diet Coke", "Diet Pepsi", "Pepsi"),
                c("Coke", "Diet Coke", "Pepsi", "Diet Pepsi", "Water")
            ),
            rating1 = c(9, 9, 7, 9, 8, 10),
            rating2 = c(7, 2, 7, 8, 6, 3),
            stringsAsFactors = FALSE
        )
    )

    test_that("casewhen works for categorical variable", {
        ds$coke_rival <- makeCaseWhenVariable(
            ds$fav_brand1 %in% c("Coke", "Diet Coke") &
                ds$fav_brand2 %in% c("Coke", "Diet Coke") ~ "Coke loyal",
            ds$fav_brand1 %in% c("Coke", "Diet Coke") ~ ds$fav_brand2,
            ds$fav_brand2 %in% c("Coke", "Diet Coke") ~ ds$fav_brand1,
            TRUE ~ Category(name = "Never interested", missing = TRUE),
            name = "Rival soda for those with Coke products in top 2"
        )

        expect_equal(
            as.vector(ds$coke_rival),
            factor(
                c("Coke loyal", "Pepsi", "Diet Pepsi", "Coke loyal", NA, NA),
                c("Coke loyal", "Coke", "Diet Coke", "Pepsi", "Diet Pepsi", "Water")
            )
        )

        expect_equal(
            names(categories(ds$coke_rival)),
            c("Coke loyal", "Never interested", "No Data", "Coke", "Diet Coke", "Pepsi", "Diet Pepsi", "Water") #nolint
        )

        expect_equal(name(ds$coke_rival), "Rival soda for those with Coke products in top 2")
    })

    test_that("casewhen works for numeric variable", {
        ds$coke_score <- makeCaseWhenVariable(
            ds$fav_brand1 == "Coke" ~ ds$rating1,
            ds$fav_brand2 == "Coke" ~ ds$rating2,
            ds$fav_brand1 == "Diet Coke" | ds$fav_brand2 == "Diet Coke" ~ 5,
            name = "Coke score"
        )

        expect_equal(
            as.vector(ds$coke_score),
            c(9, 5, 7, 9, NA, NA)
        )

        expect_equal(name(ds$coke_score), "Coke score")
    })
})