tests/testthat/test-ard_tabulate_value.survey.design.R

In cardx: Extra Analysis Results Data Utilities

skip_if_not(is_pkg_installed("survey"))

# Test survey.design works
test_that("ard_tabulate_value.survey.design() works", {
  svy_dicho <- survey::svydesign(ids = ~1, data = mtcars, weights = ~1)
  # convert variables to factor
  svy_dicho$variables <- svy_dicho$variables |>
    dplyr::mutate(across(c("cyl", "am", "vs"), as.factor))

  # row denom with by var
  expect_error(
    ard_dichotomous_row <-
      ard_tabulate_value(
        svy_dicho,
        by = vs,
        variables = c(cyl, am),
        value = list(cyl = 4),
        denominator = "row"
      ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_row,
    method = FALSE
  ))

  # col denom with by var
  expect_error(
    ard_dichotomous_col <- ard_tabulate_value(
      svy_dicho,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_col,
    method = FALSE
  ))

  # cell denom with by var
  expect_error(
    ard_dichotomous_cell <- ard_tabulate_value(
      svy_dicho,
      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 individual stats

  # section 1: by variable, row denominator
  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_row, stat_name %in% "n") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ) |>
      cards::get_ard_statistics(stat_name %in% "n") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_row, stat_name %in% "N") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ) |>
      cards::get_ard_statistics(stat_name %in% "N") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_row, stat_name %in% "p") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ) |>
      cards::get_ard_statistics(stat_name %in% "p") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_row |> dplyr::arrange_all(),
      stat_name %in% "p.std.error"
    ) |>
      unlist() |>
      unname() |>
      sort(),
    c(
      survey::svyby(
        formula = reformulate2("vs"),
        by = reformulate2("am"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[2, c(4, 5)] |>
        unlist() |>
        unname(),
      survey::svyby(
        formula = reformulate2("vs"),
        by = reformulate2("cyl"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[1, c(4, 5)] |>
        unlist() |>
        unname()
    ) |>
      sort()
  )

  # Test deff statistics when included in statistic argument
  ard_dichotomous_row_deff <- ard_tabulate_value(
    svy_dicho,
    by = vs,
    variables = c(cyl, am),
    value = list(cyl = 4),
    denominator = "row",
    statistic = everything() ~
      c(
        "n",
        "N",
        "p",
        "p.std.error",
        "deff",
        "n_unweighted",
        "N_unweighted",
        "p_unweighted"
      )
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_row_deff,
      stat_name %in% "deff"
    ) |>
      unlist() |>
      unname() |>
      sort(),
    c(
      survey::svyby(
        formula = reformulate2("vs"),
        by = reformulate2("am"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[2, c(6, 7)] |>
        unlist() |>
        unname(),
      survey::svyby(
        formula = reformulate2("vs"),
        by = reformulate2("cyl"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[1, c(6, 7)] |>
        unlist() |>
        unname()
    ) |>
      sort()
  )

  # Test that deff is not included by default (not in default statistic list)
  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_row, stat_name %in% "deff") |>
      unlist() |>
      length(),
    0L
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_row,
      stat_name %in% "n_unweighted"
    ) |>
      unlist() |>
      unname(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ) |>
      cards::get_ard_statistics(stat_name %in% "n") |>
      unlist() |>
      unname()
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_row,
      stat_name %in% "N_unweighted"
    ) |>
      unlist() |>
      unname(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ) |>
      cards::get_ard_statistics(stat_name %in% "N") |>
      unlist() |>
      unname()
  )

  # section 2: by variable, column denominator
  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_col, stat_name %in% "n") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ) |>
      cards::get_ard_statistics(stat_name %in% "n") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_col, stat_name %in% "N") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ) |>
      cards::get_ard_statistics(stat_name %in% "N") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_col, stat_name %in% "p") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ) |>
      cards::get_ard_statistics(stat_name %in% "p") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_col |> dplyr::arrange_all(),
      stat_name %in% "p.std.error"
    ) |>
      unlist() |>
      unname() |>
      sort(),
    c(
      survey::svyby(
        formula = reformulate2("am"),
        by = reformulate2("vs"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[, c(4)] |>
        unlist() |>
        unname(),
      survey::svyby(
        formula = reformulate2("cyl"),
        by = reformulate2("vs"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[, c(5)] |>
        unlist() |>
        unname()
    ) |>
      sort()
  )

  # Test deff statistics when included in statistic argument
  ard_dichotomous_col_deff <- ard_tabulate_value(
    svy_dicho,
    by = vs,
    variables = c(cyl, am),
    value = list(cyl = 4),
    denominator = "column",
    statistic = everything() ~
      c(
        "n",
        "N",
        "p",
        "p.std.error",
        "deff",
        "n_unweighted",
        "N_unweighted",
        "p_unweighted"
      )
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_col_deff |> dplyr::arrange_all(),
      stat_name %in% "deff"
    ) |>
      unlist() |>
      unname() |>
      sort(),
    c(
      survey::svyby(
        formula = reformulate2("am"),
        by = reformulate2("vs"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[1, c(6, 7)] |>
        unlist() |>
        unname(),
      survey::svyby(
        formula = reformulate2("cyl"),
        by = reformulate2("vs"),
        design = svy_dicho,
        FUN = survey::svymean,
        na.rm = TRUE,
        deff = "Design Effect"
      )[2, c(8, 9)] |>
        unlist() |>
        unname()
    ) |>
      sort()
  )

  # Test that deff is not included by default (not in default statistic list)
  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_col, stat_name %in% "deff") |>
      unlist() |>
      length(),
    0L
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_col,
      stat_name %in% "n_unweighted"
    ) |>
      unlist() |>
      unname(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ) |>
      cards::get_ard_statistics(stat_name %in% "n") |>
      unlist() |>
      unname()
  )
  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_col,
      stat_name %in% "N_unweighted"
    ) |>
      unlist() |>
      unname(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ) |>
      cards::get_ard_statistics(stat_name %in% "N") |>
      unlist() |>
      unname()
  )

  # section 3: by variable, cell denominator
  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_cell, stat_name %in% "n") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "cell"
    ) |>
      cards::get_ard_statistics(stat_name %in% "n") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_cell, stat_name %in% "N") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "cell"
    ) |>
      cards::get_ard_statistics(stat_name %in% "N") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_cell, stat_name %in% "p") |>
      unlist(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "cell"
    ) |>
      cards::get_ard_statistics(stat_name %in% "p") |>
      unlist()
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_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("vs")), !!sym(bt("cyl")))),
        design = svy_dicho,
        na.rm = TRUE,
        deff = "Design Effect"
      ))[1:2, "SE"] |>
        unlist(),
      as.data.frame(survey::svymean(
        x = inject(~ interaction(!!sym(bt("vs")), !!sym(bt("am")))),
        design = svy_dicho,
        na.rm = TRUE,
        deff = "Design Effect"
      ))[2:3, "SE"] |>
        unlist()
    )) |>
      sort()
  )

  # Test deff statistics when included in statistic argument
  ard_dichotomous_cell_deff <- ard_tabulate_value(
    svy_dicho,
    by = vs,
    variables = c(cyl, am),
    value = list(cyl = 4),
    denominator = "cell",
    statistic = everything() ~
      c(
        "n",
        "N",
        "p",
        "p.std.error",
        "deff",
        "n_unweighted",
        "N_unweighted",
        "p_unweighted"
      )
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_cell_deff |> dplyr::arrange_all(),
      stat_name %in% "deff"
    ) |>
      unlist() |>
      unname() |>
      sort(),
    unname(c(
      as.data.frame(survey::svymean(
        x = inject(~ interaction(!!sym(bt("vs")), !!sym(bt("cyl")))),
        design = svy_dicho,
        na.rm = TRUE,
        deff = "Design Effect"
      ))[1:2, "deff"] |>
        unlist(),
      as.data.frame(survey::svymean(
        x = inject(~ interaction(!!sym(bt("vs")), !!sym(bt("am")))),
        design = svy_dicho,
        na.rm = TRUE,
        deff = "Design Effect"
      ))[2:3, "deff"] |>
        unlist()
    )) |>
      sort()
  )

  # Test that deff is not included by default (not in default statistic list)
  expect_equal(
    cards::get_ard_statistics(ard_dichotomous_cell, stat_name %in% "deff") |>
      unlist() |>
      length(),
    0L
  )

  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_cell,
      stat_name %in% "n_unweighted"
    ) |>
      unlist() |>
      unname(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "cell"
    ) |>
      cards::get_ard_statistics(stat_name %in% "n") |>
      unlist() |>
      unname()
  )
  expect_equal(
    cards::get_ard_statistics(
      ard_dichotomous_cell,
      stat_name %in% "N_unweighted"
    ) |>
      unlist() |>
      unname(),
    ard_tabulate_value(
      mtcars,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "cell"
    ) |>
      cards::get_ard_statistics(stat_name %in% "N") |>
      unlist() |>
      unname()
  )

  # row denom without by var
  expect_error(
    ard_dichotomous_row <- ard_tabulate_value(
      svy_dicho,
      by = NULL,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_row,
    method = FALSE
  ))

  # col denom without by var
  expect_error(
    ard_dichotomous_col <- ard_tabulate_value(
      svy_dicho,
      by = NULL,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_col,
    method = FALSE
  ))

  # col denom without by var
  expect_error(
    ard_dichotomous_cell <- ard_tabulate_value(
      svy_dicho,
      by = NULL,
      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() works with various input types", {
  svy_dicho <- survey::svydesign(ids = ~1, data = mtcars, weights = ~1)

  # logical variables
  # convert variables to logical
  svy_dicho$variables <- svy_dicho$variables |>
    dplyr::mutate(across(c("cyl", "am", "vs"), as.logical))

  # row denom with by var
  expect_error(
    ard_dichotomous_row <-
      ard_tabulate_value(
        svy_dicho,
        by = vs,
        variables = c(cyl, am),
        value = list(cyl = TRUE),
        denominator = "row"
      ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_row,
    method = FALSE
  ))

  # col denom with by var
  expect_error(
    ard_dichotomous_col <- ard_tabulate_value(
      svy_dicho,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = TRUE),
      denominator = "column"
    ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_col,
    method = FALSE
  ))

  # cell denom with by var
  expect_error(
    ard_dichotomous_cell <- ard_tabulate_value(
      svy_dicho,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = TRUE),
      denominator = "cell"
    ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_cell,
    method = FALSE
  ))

  # variables that are neither logical or factor
  svy_dicho <- survey::svydesign(ids = ~1, data = mtcars, weights = ~1)

  svy_dicho$variables <- svy_dicho$variables |>
    dplyr::mutate(across(c("cyl", "am"), as.numeric)) |>
    dplyr::mutate(across("vs", as.character))

  # row denom with by var
  expect_error(
    ard_dichotomous_row <-
      ard_tabulate_value(
        svy_dicho,
        by = vs,
        variables = c(cyl, am),
        value = list(cyl = 4),
        denominator = "row"
      ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_row,
    method = FALSE
  ))

  # col denom with by var
  expect_error(
    ard_dichotomous_col <- ard_tabulate_value(
      svy_dicho,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "column"
    ),
    NA
  )
  expect_invisible(cards::check_ard_structure(
    ard_dichotomous_col,
    method = FALSE
  ))

  # cell denom with by var
  expect_error(
    ard_dichotomous_cell <- ard_tabulate_value(
      svy_dicho,
      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_tabulate_value.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)

  svy_dicho$variables <- svy_dicho$variables |>
    dplyr::mutate(across(c("cyl", "am"), as.logical))

  expect_snapshot(
    ard_tabulate_value(
      svy_dicho,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ),
    error = TRUE
  )

  # supplied factor value is not a level
  svy_dicho$variables <- svy_dicho$variables |>
    dplyr::mutate(across("vs", as.factor))

  svy_dicho$variables$vs
  expect_snapshot(
    ard_tabulate_value(
      svy_dicho,
      by = cyl,
      variables = c(vs, am),
      value = list(vs = 4),
      denominator = "row"
    ),
    error = TRUE
  )

  svy_dicho$variables <- svy_dicho$variables |>
    dplyr::mutate(across("disp", as.numeric))

  expect_snapshot(
    ard_tabulate_value(
      svy_dicho,
      by = cyl,
      variables = c(vs, disp),
      value = list(disp = "turn"),
      denominator = "row"
    ),
    error = TRUE
  )
})


test_that("ard_tabulate_value.survey.design() follows ard structure", {
  svy_dicho <- survey::svydesign(ids = ~1, data = mtcars, weights = ~1)
  svy_dicho$variables <- svy_dicho$variables |>
    dplyr::mutate(across(c("cyl", "am", "vs"), as.factor))
  expect_silent(
    ard_tabulate_value(
      svy_dicho,
      by = vs,
      variables = c(cyl, am),
      value = list(cyl = 4),
      denominator = "row"
    ) |>
      cards::check_ard_structure(method = FALSE)
  )
})