context("Index tables")
uni_cube <- loadCube(test_path("cubes/univariate-categorical.json"))
catXmrXmr_cube <- loadCube(test_path("cubes/cat-x-mr-x-mr.json"))
catXcat_cube <- loadCube(test_path("cubes/cat-x-cat.json"))
test_that("index table returns a CrunchCubeCalculation", {
idx_tbl <- index.table(catXcat_cube, 1)
expect_is(idx_tbl, "CrunchCubeCalculation")
expect_equal(attr(idx_tbl, "type"), "index")
expect_equal(length(attr(idx_tbl, "dims")), length(dim(idx_tbl)))
})
test_that("index table validation", {
expect_error(
index.table(uni_cube, 1),
"Index tables can only be calculated for 2 dimensional cubes."
)
expect_error(
index.table(catXmrXmr_cube, 1),
"Index tables can only be calculated for 2 dimensional cubes."
)
})
catXcat_names <- dimnames(catXcat_cube)
catXcat_names$v4 <- catXcat_names$v4[catXcat_names$v4 != "No Data"]
catXcat_names$v7 <- catXcat_names$v7[!catXcat_names$v7 %in% c("D", "No Data")]
test_that("index table on a bivariate cube", {
expect_equal(
as.array(index.table(catXcat_cube, 1)),
cubify(
107.142857142857, 85.7142857142857,
93.75, 112.5,
dims = catXcat_names
)
)
expect_equal(
as.array(index.table(catXcat_cube, 2)),
cubify(
100, 80,
100, 120,
dims = catXcat_names
)
)
})
test_that("index table with baseline", {
expect_equal(
as.array(index.table(catXcat_cube, 1, c(0.6, 0.4))),
cubify(
119.047619047619, 71.4285714285714,
104.16666666666667, 93.75,
dims = catXcat_names
)
)
expect_equal(
as.array(index.table(catXcat_cube, 2, c(0.6, 0.4))),
cubify(
83.3333333333333, 66.6666666666667,
125, 150,
dims = catXcat_names
)
)
expect_equal(
as.array(index.table(
catXcat_cube, 2,
array(c(0.6, 0.4, 0.4, 0.6), dim = c(2, 2))
)),
cubify(
83.3333333333333, 100,
125, 100,
dims = catXcat_names
)
)
})
mrXcat_cube <- loadCube(test_path("cubes/selected-crosstab-4.json"))
mrXcat_names <- dimnames(mrXcat_cube)
mrXcat_names$pdl_gender <- mrXcat_names$pdl_gender[mrXcat_names$pdl_gender != "No Data"]
test_that("index table on a bivariate cube with mr", {
expect_equal(
as.array(index.table(mrXcat_cube, 1)),
cubify(
95.3416155822363, 104.394053238208,
101.879419344372, 98.2272247381305,
97.1985863211465, 102.642452778304,
99.2098729346168, 100.745292805163,
115.700063998356, 85.1908063256891,
100.477252947149, 99.5498278652431,
dims = mrXcat_names
)
)
expect_equal(
as.array(index.table(mrXcat_cube, 2)),
cubify(
95.8651525855387, 103.859044435659,
102.305106635277, 97.8432045727022,
97.6031146323114, 102.24274029149,
98.1029444304978, 101.829068203842,
114.466510106092, 86.0656684647625,
99.2925720053358, 100.682933745397,
dims = mrXcat_names
)
)
})
test_that("index table on an mr x mr compared to calculation with mr cube", {
mr_x_mr <- loadCube(test_path("cubes/full-cube.json"))
mr_alone <- loadCube(test_path("cubes/natrep-cube.json"))
expect_equal(
as.array(index.table(mr_x_mr, 2)),
as.array(prop.table(mr_x_mr, 2)) /
broadcast(prop.table(mr_alone), dim = dim(mr_x_mr)) * 100
)
})
test_that("index.table validation", {
mean_cube <- loadCube("cubes/mean-age-food_groups-x-pasta.json")
expect_error(
index.table(mean_cube, 1),
paste0(
"You can't use CrunchCubes with measures other than count. ",
"The cube you provided included measures: mean"
)
)
})
with_test_authentication({
ds <- newDatasetFromFixture("apidocs")
test_that("proof: index.table(~x+y, 2) == prop.table(~x+y, 2)/prop.table(~x)*100", {
bivariate_cube <- crtabs(~ allpets + country, data = ds)
univariate_allpets <- crtabs(~allpets, data = ds)
univariate_country <- crtabs(~country, data = ds)
expect_equal(
as.array(index.table(bivariate_cube, 2)),
as.array(prop.table(bivariate_cube, 2)) /
broadcast(as.array(prop.table(univariate_allpets)), dim = dim(bivariate_cube)) * 100
)
expect_equal(
as.array(index.table(bivariate_cube, 1)),
as.array(prop.table(bivariate_cube, 1)) /
broadcast(as.array(prop.table(univariate_country)), dim = dim(bivariate_cube)) * 100
)
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.