tests/testthat/test-deep-copy-variable.R

context("Deep copies of variables")

with_test_authentication({
    ds <- newDatasetFromFixture("apidocs")
    test_that("Can deep copy categorical", {
        ds$q1a <- copy(ds$q1, deep = TRUE)
        expect_identical(as.vector(ds$q1), as.vector(ds$q1a))
    })
    test_that("Can deep copy numeric", {
        ds$ndogsa <- copy(ds$ndogs, deep = TRUE)
        expect_identical(as.vector(ds$ndogs), as.vector(ds$ndogsa))
    })
    test_that("Can deep copy datetime", {
        ds$wavea <- copy(ds$wave, deep = TRUE)
        expect_identical(as.vector(ds$wave), as.vector(ds$wavea))
    })
    test_that("Can deep copy multiple response", {
        ds$allpetsa <- copy(ds$allpets, deep = TRUE)
        for (i in 1:2) {
            ## Whole thing isn't identical because the aliases are different
            expect_identical(
                as.vector(ds$allpets[[i]]),
                as.vector(ds$allpetsa[[i]])
            )
        }
        expect_equivalent(
            as.array(crtabs(~allpets, data = ds)),
            as.array(crtabs(~allpetsa, data = ds))
        )
    })
    test_that("Can deep copy categorical array", {
        ds$petloca <- copy(ds$petloc, deep = TRUE)
        for (i in 1:2) {
            ## Whole thing isn't identical because the aliases are different
            expect_identical(
                as.vector(ds$petloc[[i]]),
                as.vector(ds$petloca[[i]])
            )
        }
        expect_equivalent(
            as.array(crtabs(~petloc, data = ds)),
            as.array(crtabs(~petloca, data = ds))
        )
    })

    part2 <- newDatasetFromFixture("apidocs")
    test_that("Deep copies don't get data when appending", {
        out <- appendDataset(ds, part2)
        ## Counts should be double in the original than in the copy
        expect_equivalent(
            as.array(crtabs(~q1, data = out)),
            2 * as.array(crtabs(~q1a, data = out))
        )
        expect_equivalent(
            as.array(crtabs(~petloc, data = out)),
            2 * as.array(crtabs(~petloca, data = out))
        )
    })
})

Try the crunch package in your browser

Any scripts or data that you put into this service are public.

crunch documentation built on Aug. 31, 2023, 1:07 a.m.