tests/testthat/test-append-subvariables.R

In Crunch-io/rcrunch: Crunch.io Data Tools

context("Appending datasets with unbound subvariables")

with_test_authentication({
    # Revisit after https://www.pivotaltracker.com/n/projects/2172644/stories/186660623
    # (reusable subvar codes) ships
    # whereas("When appending a dataset with unbound subvariables", {
    #     part1 <- mrdf.setup(newDataset(mrdf), selections = "1.0")
    #     mr_cats <- categories(part1$MR)
    #     subvar_cats <- categories(part1$MR$mr_1)
    #     dichotomized_cats <- Categories(
    #         list(id = 2L, missing = FALSE, name = "0.0", numeric_value = 0, selected = FALSE),
    #         list(id = 1L, missing = FALSE, name = "1.0", numeric_value = 1, selected = TRUE),
    #         list(id = -1L, missing = TRUE, name = "No Data", numeric_value = NULL, selected = FALSE)
    #     )
    #     ## Dichotomize this way so that categories get aligned
    #     ## (via supertype)
    #
    #     part2 <- mrdf.setup(newDataset(mrdf))
    #     unbind(part2$CA)
    #     part2 <- refresh(part2)
    #     undichotomized_cats <- Categories(
    #         list(id = 2L, missing = FALSE, name = "0.0", numeric_value = 0),
    #         list(id = 1L, missing = FALSE, name = "1.0", numeric_value = 1),
    #         list(id = -1L, missing = TRUE, name = "No Data", numeric_value = NULL)
    #     )
    #     test_that("set up MR for appending", {
    #         expect_true(is.Multiple(part1$MR))
    #         expect_equivalent(
    #             as.array(crtabs(~MR, data = part1)),
    #             array(c(2, 1, 1),
    #                 dim = c(3L),
    #                 dimnames = list(MR = c("mr_1", "mr_2", "mr_3"))
    #             )
    #         )
    #         expect_null(part2$MR)
    #         expect_identical(mr_cats, subvar_cats)
    #         expect_identical(mr_cats, dichotomized_cats)
    #         expect_identical(
    #             categories(part2$mr_1),
    #             undichotomized_cats
    #         )
    #         expect_false(identical(
    #             dichotomized_cats,
    #             undichotomized_cats
    #         )) ## Just being clear about that
    #         expect_identical(
    #             as.vector(part1$MR$mr_1),
    #             as.vector(part2$mr_1)
    #         )
    #         expect_identical(
    #             as.vector(part1$MR$mr_2),
    #             as.vector(part2$mr_2)
    #         )
    #         expect_identical(
    #             as.vector(part1$MR$mr_3),
    #             as.vector(part2$mr_3)
    #         )
    #     })
    #     out <- suppressMessages(try(appendDataset(part1, part2)))
    #     test_that("Dataset #2 isn't modified by appending to another", {
    #         part2 <- refresh(part2)
    #         expect_null(part2$MR)
    #         expect_true(is.Categorical(part2$mr_1))
    #     })
    #     test_that("the unbound subvariables get lined up", {
    #         expect_true(is.dataset(out))
    #         expect_length(batches(out), 2)
    #         expect_identical(dim(out), c(nrow(mrdf) * 2L, 2L))
    #         expect_true(is.variable(out$MR))
    #         expect_identical(categories(out$MR), dichotomized_cats)
    #         expect_identical(categories(out$MR$mr_1), dichotomized_cats)
    #         expect_false(identical(
    #             categories(out$MR),
    #             undichotomized_cats
    #         ))
    #         expect_identical(
    #             as.vector(out$MR$mr_1),
    #             rep(as.vector(part2$mr_1), 2)
    #         )
    #         expect_true(is.Multiple(out$MR))
    #         expect_identical(
    #             names(subvariables(out$MR)),
    #             c("mr_1", "mr_2", "mr_3")
    #         )
    #         expect_equivalent(
    #             as.array(crtabs(~MR, data = out)),
    #             array(c(4, 2, 2),
    #                 dim = c(3L),
    #                 dimnames = list(MR = c("mr_1", "mr_2", "mr_3"))
    #             )
    #         )
    #     })
    # })

    whereas("When appending arrays with different subsets of subvariables", {
        part1 <- mrdf.setup(newDataset(mrdf[-3]), selections = "1.0")
        part1 <- saveVersion(part1, "Before appending")
        part2 <- mrdf.setup(newDataset(mrdf[-1]), selections = "1.0")
        test_that("set up MR for appending", {
            expect_true(is.Multiple(part1$MR))
            expect_identical(
                names(subvariables(part1$MR)),
                c("mr_1", "mr_2")
            )
            expect_equivalent(
                as.array(crtabs(~MR, data = part1)),
                array(c(2, 1),
                    dim = c(2L),
                    dimnames = list(MR = c("mr_1", "mr_2"))
                )
            )
            expect_true(is.Multiple(part2$MR))
            expect_identical(
                names(subvariables(part2$MR)),
                c("mr_2", "mr_3")
            )
            expect_equivalent(
                as.array(crtabs(~MR, data = part2)),
                array(c(1, 1),
                    dim = c(2L),
                    dimnames = list(MR = c("mr_2", "mr_3"))
                )
            )
        })
        out <- suppressMessages(try(appendDataset(part1, part2)))
        test_that("the arrays with different subvariables can append", {
            expect_true(is.dataset(out))
            expect_length(batches(out), 2)
            expect_identical(dim(out), c(nrow(mrdf) * 2L, 2L))
            expect_true(is.variable(out$MR))
            expect_true(is.Multiple(out$MR))
            expect_identical(
                names(subvariables(out$MR)),
                c("mr_1", "mr_2", "mr_3")
            )
            expect_equivalent(
                as.array(crtabs(~MR, data = out)),
                array(c(2, 2, 1),
                    dim = c(3L),
                    dimnames = list(MR = c("mr_1", "mr_2", "mr_3"))
                )
            )
        })

        test_that("Rolling back to initial import reverts the append", {
            out <- restoreVersion(out, "Before appending")
            expect_true(is.Multiple(out$MR))
            expect_identical(
                names(subvariables(out$MR)),
                c("mr_1", "mr_2")
            )
            expect_equivalent(
                as.array(crtabs(~MR, data = out)),
                array(c(2, 1),
                    dim = c(2L),
                    dimnames = list(MR = c("mr_1", "mr_2"))
                )
            )
            expect_length(batches(out), 2)
        })
    })
})