diff --git a/tests/testthat/test-ard_categorical.survey.design.R b/tests/testthat/test-ard_categorical.survey.design.R index 00aa88f40..ed89270c4 100644 --- a/tests/testthat/test-ard_categorical.survey.design.R +++ b/tests/testthat/test-ard_categorical.survey.design.R @@ -429,33 +429,36 @@ test_that("ard_categorical.survey.design() returns an error when variables have svy_titanic$variables$Class <- fct_na_value_to_level(svy_titanic$variables$Class) expect_snapshot( - ard_categorical( - svy_titanic, - variables = c(Class, Age), - by = Survived, - denominator = "row" - ), error = TRUE) + ard_categorical( + svy_titanic, + variables = c(Class, Age), + by = Survived, + denominator = "row" + ), + error = TRUE + ) # column denom expect_snapshot( - ard_categorical( - svy_titanic, - variables = c(Class, Age), - by = Survived, - denominator = "column" - ), error = TRUE + ard_categorical( + svy_titanic, + variables = c(Class, Age), + by = Survived, + denominator = "column" + ), + error = TRUE ) # cell denom expect_snapshot( ard_categorical( - svy_titanic, - variables = c(Class, Age), - by = Survived, - denominator = "cell" - ), error = TRUE + svy_titanic, + variables = c(Class, Age), + by = Survived, + denominator = "cell" + ), + error = TRUE ) - }) # - Do we get results for unobserved factor levels in the `by` and `variable` variables? @@ -527,25 +530,25 @@ test_that("ard_categorical.survey.design() works for unobserved factor levels", ) expect_equal( - cards::get_ard_statistics(ard_svy_cat_row |> dplyr::arrange_all(), stat_name %in% "p.std.error") |> unlist() |> unname() |> sort(), - unname(c( - survey::svyby( - formula = reformulate2("Survived"), - by = reformulate2("Age"), - design = svy_titanic, - FUN = survey::svymean, - na.rm = TRUE, - deff = "Design Effect" - )[, c("se.SurvivedYes", "se.SurvivedNo", "se.SurvivedUnknown")] |> unlist(), - survey::svyby( - formula = reformulate2("Survived"), - by = reformulate2("Class"), - design = svy_titanic, - FUN = survey::svymean, - na.rm = TRUE, - deff = "Design Effect" - )[, c("se.SurvivedYes", "se.SurvivedNo", "se.SurvivedUnknown")] |> unlist() - )) |> sort() + cards::get_ard_statistics(ard_svy_cat_row |> dplyr::arrange_all(), stat_name %in% "p.std.error") |> unlist() |> unname() |> sort(), + unname(c( + survey::svyby( + formula = reformulate2("Survived"), + by = reformulate2("Age"), + design = svy_titanic, + FUN = survey::svymean, + na.rm = TRUE, + deff = "Design Effect" + )[, c("se.SurvivedYes", "se.SurvivedNo", "se.SurvivedUnknown")] |> unlist(), + survey::svyby( + formula = reformulate2("Survived"), + by = reformulate2("Class"), + design = svy_titanic, + FUN = survey::svymean, + na.rm = TRUE, + deff = "Design Effect" + )[, c("se.SurvivedYes", "se.SurvivedNo", "se.SurvivedUnknown")] |> unlist() + )) |> sort() ) expect_equal( @@ -604,7 +607,7 @@ test_that("ard_categorical.survey.design() works for unobserved factor levels", deff = "Design Effect" )[, c("se.Class1st", "se.Class2nd", "se.Class3rd", "se.ClassCrew")] |> unlist() )) |> sort() - ) + ) expect_equal( cards::get_ard_statistics(ard_svy_cat_col, stat_name %in% "n_unweighted") |> unlist() |> unname() |> sort(), @@ -643,25 +646,25 @@ test_that("ard_categorical.survey.design() works for unobserved factor levels", ) expect_equal( - cards::get_ard_statistics(ard_svy_cat_cell |> dplyr::arrange_all(), stat_name %in% "p.std.error") |> unlist() |> unname() |> sort(), - unname(c( - as.data.frame(survey::svymean( - x = inject(~ interaction(!!sym(bt("Survived")), !!sym(bt("Class")))), - design = svy_titanic, - na.rm = TRUE, - deff = "Design Effect" - ))[, "SE"] |> unlist(), - as.data.frame(survey::svymean( - x = inject(~ interaction(!!sym(bt("Survived")), !!sym(bt("Age")))), - design = svy_titanic, - na.rm = TRUE, - deff = "Design Effect" - ))[, "SE"] |> unlist() - )) |> sort() + cards::get_ard_statistics(ard_svy_cat_cell |> dplyr::arrange_all(), stat_name %in% "p.std.error") |> unlist() |> unname() |> sort(), + unname(c( + as.data.frame(survey::svymean( + x = inject(~ interaction(!!sym(bt("Survived")), !!sym(bt("Class")))), + design = svy_titanic, + na.rm = TRUE, + deff = "Design Effect" + ))[, "SE"] |> unlist(), + as.data.frame(survey::svymean( + x = inject(~ interaction(!!sym(bt("Survived")), !!sym(bt("Age")))), + design = svy_titanic, + na.rm = TRUE, + deff = "Design Effect" + ))[, "SE"] |> unlist() + )) |> sort() ) expect_equal( - cards::get_ard_statistics(ard_svy_cat_cell, stat_name %in% "n_unweighted") |> unlist() |> unname() |> sort() , + cards::get_ard_statistics(ard_svy_cat_cell, stat_name %in% "n_unweighted") |> unlist() |> unname() |> sort(), cards::ard_categorical(df_uw, variables = c(Class, Age), by = Survived, denominator = "cell") |> cards::get_ard_statistics(stat_name %in% "n") |> unlist() |> unname() |> sort() ) @@ -939,7 +942,7 @@ test_that("ard_categorical.survey.design() works for unobserved logical levels", ) expect_equal( - cards::get_ard_statistics(ard_svy_cat_cell |> dplyr::arrange_all(), stat_name %in% "p.std.error") |> unlist() |> unname() |> sort(), + cards::get_ard_statistics(ard_svy_cat_cell |> dplyr::arrange_all(), stat_name %in% "p.std.error" & group1_level == TRUE) |> unlist() |> unname() |> sort(), unname(c( as.data.frame(survey::svymean( x = inject(~ interaction(!!sym(bt("Survived")), !!sym(bt("Class")))), @@ -957,7 +960,7 @@ test_that("ard_categorical.survey.design() works for unobserved logical levels", ) expect_equal( - cards::get_ard_statistics(ard_svy_cat_cell, stat_name %in% "n_unweighted") |> unlist() |> unname() |> sort() , + cards::get_ard_statistics(ard_svy_cat_cell, stat_name %in% "n_unweighted") |> unlist() |> unname() |> sort(), cards::ard_categorical(df_uw, variables = c(Class, Age), by = Survived, denominator = "cell") |> cards::get_ard_statistics(stat_name %in% "n") |> unlist() |> unname() |> sort() ) diff --git a/tests/testthat/test-ard_dichotomous.survey.design.R b/tests/testthat/test-ard_dichotomous.survey.design.R index 9a27e8489..1fdc49ebc 100644 --- a/tests/testthat/test-ard_dichotomous.survey.design.R +++ b/tests/testthat/test-ard_dichotomous.survey.design.R @@ -1,6 +1,6 @@ skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx")) -#Test survey.design works +# Test survey.design works test_that("ard_dichotomous.survey.design() works", { svy_dicho <- survey::svydesign(ids = ~1, data = mtcars, weights = ~1) # convert variables to factor @@ -50,7 +50,7 @@ test_that("ard_dichotomous.survey.design() works", { # section 1: by variable, row denominator expect_equal( cards::get_ard_statistics(ard_dichotomous_row, stat_name %in% "n") |> unlist(), - cards::ard_dichotomous(mtcars, + ard_dichotomous(mtcars, by = vs, variables = c(cyl, am), value = list(cyl = 4), @@ -323,10 +323,10 @@ test_that("ard_dichotomous.survey.design() works with various input types", { expect_error( ard_dichotomous_row <- ard_dichotomous(svy_dicho, - by = vs, - variables = c(cyl, am), - value = list(cyl = TRUE), - denominator = "row" + by = vs, + variables = c(cyl, am), + value = list(cyl = TRUE), + denominator = "row" ), NA ) @@ -335,10 +335,10 @@ test_that("ard_dichotomous.survey.design() works with various input types", { # col denom with by var expect_error( ard_dichotomous_col <- ard_dichotomous(svy_dicho, - by = vs, - variables = c(cyl, am), - value = list(cyl = TRUE), - denominator = "column" + by = vs, + variables = c(cyl, am), + value = list(cyl = TRUE), + denominator = "column" ), NA ) @@ -347,10 +347,10 @@ test_that("ard_dichotomous.survey.design() works with various input types", { # cell denom with by var expect_error( ard_dichotomous_cell <- ard_dichotomous(svy_dicho, - by = vs, - variables = c(cyl, am), - value = list(cyl = TRUE), - denominator = "cell" + by = vs, + variables = c(cyl, am), + value = list(cyl = TRUE), + denominator = "cell" ), NA ) @@ -368,10 +368,10 @@ test_that("ard_dichotomous.survey.design() works with various input types", { expect_error( ard_dichotomous_row <- ard_dichotomous(svy_dicho, - by = vs, - variables = c(cyl, am), - value = list(cyl = 4), - denominator = "row" + by = vs, + variables = c(cyl, am), + value = list(cyl = 4), + denominator = "row" ), NA ) @@ -380,10 +380,10 @@ test_that("ard_dichotomous.survey.design() works with various input types", { # col denom with by var expect_error( ard_dichotomous_col <- ard_dichotomous(svy_dicho, - by = vs, - variables = c(cyl, am), - value = list(cyl = 4), - denominator = "column" + by = vs, + variables = c(cyl, am), + value = list(cyl = 4), + denominator = "column" ), NA ) @@ -392,20 +392,18 @@ test_that("ard_dichotomous.survey.design() works with various input types", { # cell denom with by var expect_error( ard_dichotomous_cell <- ard_dichotomous(svy_dicho, - by = vs, - variables = c(cyl, am), - value = list(cyl = 4), - denominator = "cell" + by = vs, + variables = c(cyl, am), + value = list(cyl = 4), + denominator = "cell" ), NA ) expect_invisible(cards::check_ard_structure(ard_dichotomous_cell, method = FALSE)) - }) test_that("ard_dichotomous.survey.design() returns an error with erroneous input", { - # value passed in is not logical should return an error svy_dicho <- survey::svydesign(ids = ~1, data = mtcars, weights = ~1) @@ -414,13 +412,13 @@ test_that("ard_dichotomous.survey.design() returns an error with erroneous input expect_snapshot( ard_dichotomous(svy_dicho, - by = vs, - variables = c(cyl, am), - value = list(cyl = 4), - denominator = "row" + by = vs, + variables = c(cyl, am), + value = list(cyl = 4), + denominator = "row" ), - error = TRUE -) + error = TRUE + ) # supplied factor value is not a level svy_dicho$variables <- svy_dicho$variables |> @@ -429,10 +427,10 @@ test_that("ard_dichotomous.survey.design() returns an error with erroneous input svy_dicho$variables$vs expect_snapshot( ard_dichotomous(svy_dicho, - by = cyl, - variables = c(vs, am), - value = list(vs = 4), - denominator = "row" + by = cyl, + variables = c(vs, am), + value = list(vs = 4), + denominator = "row" ), error = TRUE ) @@ -442,10 +440,10 @@ test_that("ard_dichotomous.survey.design() returns an error with erroneous input expect_snapshot( ard_dichotomous(svy_dicho, - by = cyl, - variables = c(vs, disp), - value = list(disp = "turn"), - denominator = "row" + by = cyl, + variables = c(vs, disp), + value = list(disp = "turn"), + denominator = "row" ), error = TRUE )