tests/testthat/test-tabsurvey.R

In R4VN: Health Data Analysis and Publication-Ready Reporting

# ============================================================================
# Tests for R4VN surveyset() and tabsurvey()
# Put this file in tests/testthat/test-tabsurvey.R
# ============================================================================

testthat::skip_if_not_installed("survey")

.make_r4vn_survey_test_data <- function() {
  set.seed(20260814)

  strata <- rep(1:6, each = 80)
  # PSU ids intentionally repeat across strata to test nest = TRUE.
  psu <- rep(rep(1:8, each = 10), 6)
  n <- length(strata)

  age <- round(rnorm(n, 45, 13))
  bmi <- round(rnorm(n, 23.5, 3.2), 1)
  sex <- factor(sample(c("Female", "Male"), n, TRUE),
                levels = c("Female", "Male"))
  smoking <- factor(
    sample(c("No", "Yes"), n, TRUE, prob = c(.72, .28)),
    levels = c("No", "Yes")
  )
  wt <- runif(n, .4, 2.8)

  lp <- -4.2 +
    .045 * age +
    .09 * (bmi - 23) +
    .45 * (sex == "Male") +
    .55 * (smoking == "Yes")

  hypertension <- factor(
    rbinom(n, 1, plogis(lp)),
    levels = 0:1,
    labels = c("No", "Yes")
  )

  sbp <- 82 + .75 * age + .85 * bmi +
    5 * (sex == "Male") + rnorm(n, 0, 13)

  out <- data.frame(
    id = seq_len(n),
    strata = strata,
    psu = psu,
    wt = wt,
    age = age,
    sex = sex,
    bmi = bmi,
    smoking = smoking,
    hypertension = hypertension,
    sbp = sbp,
    stringsAsFactors = FALSE
  )

  attr(out$age, "label") <- "Age (years)"
  attr(out$sex, "label") <- "Sex"
  attr(out$bmi, "label") <- "Body mass index"
  attr(out$smoking, "label") <- "Current smoking"
  attr(out$hypertension, "label") <- "Hypertension"
  attr(out$sbp, "label") <- "Systolic blood pressure"

  out
}


testthat::test_that("surveyset creates a reusable R4VN survey design", {
  d <- .make_r4vn_survey_test_data()

  s <- surveyset(
    d,
    name = "test_main",
    weight = wt,
    strata = strata,
    cluster = psu,
    active = TRUE
  )

  testthat::expect_s3_class(s, "r4vn_survey")
  testthat::expect_equal(s$name, "test_main")
  testthat::expect_equal(s$weight, "wt")
  testthat::expect_equal(s$strata, "strata")
  testthat::expect_equal(s$cluster, "psu")
  testthat::expect_equal(s$weightscale, "relative")

  ss <- summary(s)
  testthat::expect_true(is.data.frame(ss))
  testthat::expect_true(all(c("Item", "Value") %in% names(ss)))
  testthat::expect_true(any(ss$Item == "Kish weight ESS"))
})


testthat::test_that("weighted descriptive table is the default and retains raw n", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_weighted",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    design = "test_weighted",
    show = FALSE
  )

  testthat::expect_s3_class(z, "r4vn_tabsurvey")
  testthat::expect_s3_class(z, "r4vn_tab")
  testthat::expect_true(is.data.frame(z$data))
  testthat::expect_true("Overall | Weighted Estimate" %in% names(z$data))
  testthat::expect_false("Overall | Unweighted Estimate" %in% names(z$data))
  testthat::expect_true("Overall | Weighted n" %in% names(z$data))
  testthat::expect_true("Overall | Weighted 95% CI" %in% names(z$data))
  testthat::expect_true(any(nzchar(z$data[["Overall | Weighted 95% CI"]])))
})


testthat::test_that("publication column names are preserved exactly", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_exact_names",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex),
    design = "test_exact_names",
    result = "both",
    show = FALSE
  )

  testthat::expect_true("Overall | Unweighted n" %in% names(z$data))
  testthat::expect_true("Overall | Unweighted Estimate" %in% names(z$data))
  testthat::expect_true("Overall | Weighted n" %in% names(z$data))
  testthat::expect_true("Overall | Weighted Estimate" %in% names(z$data))
  testthat::expect_false(any(grepl("\\.\\.\\.", names(z$data))))
})


testthat::test_that("result both computes weighted and unweighted descriptives", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_both",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, q.bmi, b2.smoking),
    design = "test_both",
    result = "both",
    bothstyle = "columns",
    show = FALSE
  )

  testthat::expect_true("Overall | Unweighted Estimate" %in% names(z$data))
  testthat::expect_true("Overall | Weighted Estimate" %in% names(z$data))

  age_row <- grep("^Age \\(years\\), Mean", z$data$Characteristic)
  testthat::expect_true(length(age_row) >= 1L)
  testthat::expect_false(
    identical(
      z$data[["Overall | Unweighted Estimate"]][age_row[1]],
      z$data[["Overall | Weighted Estimate"]][age_row[1]]
    )
  )
})


testthat::test_that("bothstyle rows creates an Analysis column", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_rows",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex),
    design = "test_rows",
    result = "both",
    bothstyle = "rows",
    show = FALSE
  )

  testthat::expect_true("Analysis" %in% names(z$data))
  testthat::expect_true(all(c("Unweighted", "Weighted") %in% unique(z$data$Analysis)))
})



testthat::test_that("Overall remains an overall distribution under row percentages", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_row_overall",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(sex),
    by = hypertension,
    design = "test_row_overall",
    result = "unweighted",
    row = TRUE, col = FALSE, cell = FALSE,
    overall = "first",
    show = FALSE
  )

  lev <- z$data[z$data$Characteristic %in% c("Female", "Male"), , drop = FALSE]
  testthat::expect_equal(nrow(lev), 2L)
  # If Overall had incorrectly used the row denominator, both would be 100%.
  testthat::expect_true("Overall | Unweighted Estimate" %in% names(lev))
  testthat::expect_false(
    all(grepl("100.0%", lev[["Overall | Unweighted Estimate"]], fixed = TRUE))
  )
})

testthat::test_that("categorical by produces ordinary and design-based tests", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_by",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_by",
    result = "both",
    test = TRUE,
    show = FALSE
  )

  testthat::expect_true("p | Unweighted" %in% names(z$data))
  testthat::expect_true("p | Weighted" %in% names(z$data))
  testthat::expect_true(is.data.frame(z$tests))
  testthat::expect_true(any(z$tests$analysis == "Weighted"))
  testthat::expect_true(any(grepl("Rao-Scott", z$tests$method, fixed = TRUE)))
})



testthat::test_that("rvrow and rvcol mirror tab display behavior", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_reverse",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(sex, smoking),
    by = hypertension,
    design = "test_reverse",
    rvrow = vars(sex),
    rvcol = TRUE,
    or = TRUE,
    event = "Yes",
    show = FALSE
  )

  # Display is reversed, event/reference logic remains explicit/stable.
  sex_rows <- which(z$data$Characteristic %in% c("Female", "Male"))
  testthat::expect_true(length(sex_rows) == 2L)
  testthat::expect_identical(z$data$Characteristic[sex_rows[1L]], "Male")
  testthat::expect_identical(z$by_levels, rev(z$original_by_levels))
  testthat::expect_identical(z$event, "Yes")
})

testthat::test_that("OR is shown together with descriptive statistics", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_or",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_or",
    or = TRUE,
    event = "Yes",
    result = "both",
    show = FALSE
  )

  testthat::expect_true(any(grepl("Crude OR", names(z$data), fixed = TRUE)))
  testthat::expect_true(is.data.frame(z$effects))
  testthat::expect_true(any(z$effects$effect == "OR"))
  testthat::expect_true(any(z$effects$analysis == "Weighted"))
  testthat::expect_true(any(z$effects$analysis == "Unweighted"))
})


testthat::test_that("b2 reference is respected in weighted and unweighted models", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_reference",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(b2.sex, c.age),
    by = hypertension,
    design = "test_reference",
    or = TRUE,
    event = "Yes",
    result = "both",
    show = FALSE
  )

  ref <- z$effects[
    z$effects$variable == "sex" &
      z$effects$level == "Male" &
      z$effects$reference,
    ,
    drop = FALSE
  ]

  testthat::expect_true(nrow(ref) >= 2L)
  testthat::expect_true(all(c("Weighted", "Unweighted") %in% ref$analysis))
})



testthat::test_that("effect_ref and multi reference specifications are independent", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_effect_ref",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(sex, smoking, c.age),
    by = hypertension,
    design = "test_effect_ref",
    or = TRUE,
    event = "Yes",
    effect_ref = list(smoking = "Yes"),
    multi = vars(sex, b2.smoking, c.age),
    result = "weighted",
    show = FALSE
  )

  crude_ref <- z$effects[
    z$effects$variable == "smoking" &
      z$effects$stage == "Crude" &
      z$effects$reference,
    , drop = FALSE
  ]
  multi_ref <- z$effects[
    z$effects$variable == "smoking" &
      z$effects$stage == "Multivariable" &
      z$effects$reference,
    , drop = FALSE
  ]

  testthat::expect_true(nrow(crude_ref) >= 1L)
  testthat::expect_true(nrow(multi_ref) >= 1L)
  testthat::expect_true(all(crude_ref$level == "Yes"))
  testthat::expect_true(all(multi_ref$level == "Yes"))
})


testthat::test_that("multi can use a reference different from the table reference", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_multi_reference",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(smoking, c.age),       # table/crude reference = No
    by = hypertension,
    design = "test_multi_reference",
    or = TRUE,
    event = "Yes",
    multi = vars(b2.smoking, c.age),  # multivariable reference = Yes
    show = FALSE
  )

  crude_ref <- z$effects[
    z$effects$variable == "smoking" &
      z$effects$stage == "Crude" &
      z$effects$reference,
    , drop = FALSE
  ]
  multi_ref <- z$effects[
    z$effects$variable == "smoking" &
      z$effects$stage == "Multivariable" &
      z$effects$reference,
    , drop = FALSE
  ]

  testthat::expect_true(all(crude_ref$level == "No"))
  testthat::expect_true(all(multi_ref$level == "Yes"))
})

testthat::test_that("PR and multivariable model work", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_pr",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_pr",
    pr = TRUE,
    event = "Yes",
    multi = TRUE,
    show = FALSE
  )

  testthat::expect_true(any(grepl("Multivariable PR", names(z$data), fixed = TRUE)))
  testthat::expect_true(any(z$effects$effect == "PR"))
  testthat::expect_true(any(z$effects$stage == "Multivariable"))
})


testthat::test_that("separate adjusted models are available", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_adjusted",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_adjusted",
    or = TRUE,
    event = "Yes",
    adjusted = vars(c.age, b2.sex),
    show = FALSE
  )

  testthat::expect_true(any(grepl("Adjusted OR", names(z$data), fixed = TRUE)))
  testthat::expect_true(any(z$effects$stage == "Adjusted"))
})


testthat::test_that("continuous outcome automatically reports beta", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_beta",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = c.sbp,
    design = "test_beta",
    multi = TRUE,
    result = "both",
    show = FALSE
  )

  testthat::expect_true(any(grepl("\u03b2", names(z$data), fixed = TRUE)))
  testthat::expect_true(any(z$effects$effect == "\u03b2"))
  testthat::expect_true(any(z$effects$stage == "Multivariable"))
})


testthat::test_that("q continuous outcome uses rank-oriented tests but beta effects", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_qoutcome",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(b2.sex, b2.smoking),
    by = q.sbp,
    design = "test_qoutcome",
    result = "both",
    test = TRUE,
    show = FALSE
  )

  testthat::expect_true(any(grepl("rank", z$tests$method, ignore.case = TRUE)))
  testthat::expect_true(any(z$effects$effect == "\u03b2"))
})


testthat::test_that("subpopulation is handled as a survey domain", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_domain",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(b2.sex, hypertension, c.bmi),
    design = "test_domain",
    subpop = age >= 60,
    show = FALSE
  )

  testthat::expect_true(grepl("age >= 60", z$subpop, fixed = TRUE))
  testthat::expect_true(any(grepl("Domain/subpopulation", z$notes, fixed = TRUE)))
})


testthat::test_that("relative weights cannot be mislabeled as population totals", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_relative",
    weight = wt, strata = strata, cluster = psu,
    weightscale = "relative"
  )

  testthat::expect_error(
    tabsurvey(
      vars = vars(sex, hypertension),
      design = "test_relative",
      population = TRUE,
      show = FALSE
    ),
    "weightscale"
  )
})


testthat::test_that("population totals are available only when explicitly declared", {
  d <- .make_r4vn_survey_test_data()

  # For testing only: rescale to an expansion-like weight.
  d$popwt <- d$wt * 500

  surveyset(
    d, name = "test_population",
    weight = popwt, strata = strata, cluster = psu,
    weightscale = "population"
  )

  z <- tabsurvey(
    vars = vars(sex, hypertension),
    design = "test_population",
    population = TRUE,
    show = FALSE
  )

  testthat::expect_true(
    "Overall | Weighted Population N" %in% names(z$data) &&
      any(nzchar(z$data[["Overall | Weighted Population N"]]))
  )
})


testthat::test_that("f prefix creates mean median and range rows", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_full",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(f.age, f.bmi),
    design = "test_full",
    result = "both",
    show = FALSE
  )

  testthat::expect_true(any(grepl("Mean \\(SD\\)", z$data$Characteristic)))
  testthat::expect_true(any(grepl("Median \\(IQR\\)", z$data$Characteristic)))
  testthat::expect_true(any(z$data$Characteristic == "Range"))
})


testthat::test_that("one-off design works without surveyset", {
  d <- .make_r4vn_survey_test_data()

  z <- tabsurvey(
    d,
    vars = vars(c.age, b2.sex, hypertension),
    weight = wt,
    strata = strata,
    cluster = psu,
    show = FALSE
  )

  testthat::expect_s3_class(z, "r4vn_tabsurvey")
  testthat::expect_equal(z$design$name, "<temporary>")
})


testthat::test_that("named survey designs can coexist", {
  d <- .make_r4vn_survey_test_data()
  d$wt2 <- d$wt * runif(nrow(d), .8, 1.2)

  s1 <- surveyset(
    d, name = "interview",
    weight = wt, strata = strata, cluster = psu,
    active = TRUE
  )
  s2 <- surveyset(
    d, name = "exam",
    weight = wt2, strata = strata, cluster = psu,
    active = FALSE
  )

  z1 <- tabsurvey(
    vars = vars(c.age, sex),
    design = "interview",
    show = FALSE
  )
  z2 <- tabsurvey(
    vars = vars(c.age, sex),
    design = "exam",
    show = FALSE
  )

  testthat::expect_equal(z1$design$name, "interview")
  testthat::expect_equal(z2$design$name, "exam")
  testthat::expect_false(
    identical(
      z1$data[["Overall | Weighted Estimate"]],
      z2$data[["Overall | Weighted Estimate"]]
    )
  )
})


testthat::test_that("replicate-weight column ranges are parsed", {
  d <- .make_r4vn_survey_test_data()

  # This test focuses on the column-range parser without requiring a valid
  # replicate design construction.
  d$rep1 <- d$wt
  d$rep2 <- d$wt
  d$rep3 <- d$wt

  expr <- quote(rep1:rep3)
  nm <- .r4vn_sv_names_from_expr(
    expr, d, parent.frame(),
    arg = "repweights",
    allow_null = FALSE,
    allow_multi = TRUE
  )

  testthat::expect_identical(nm, c("rep1", "rep2", "rep3"))
})


testthat::test_that("tabexport accepts tabsurvey through r4vn_tab inheritance", {
  testthat::skip_if_not(exists("tabexport", mode = "function"))

  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_export",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex),
    design = "test_export",
    show = FALSE
  )

  testthat::expect_true(inherits(z, "r4vn_tab"))
  testthat::expect_true(grepl("table-title", z$table_html, fixed = TRUE))
  testthat::expect_true(grepl("table-note", z$table_html, fixed = TRUE))

  flat <- tabexport(z)
  testthat::expect_true(is.data.frame(flat))
  testthat::expect_equal(nrow(flat), nrow(z$data))
})


testthat::test_that("default publication layout separates estimate and CI columns", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_separate_columns",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_separate_columns",
    or = TRUE,
    event = "Yes",
    result = "both",
    show = FALSE
  )

  testthat::expect_true("No | Weighted Estimate" %in% names(z$data))
  testthat::expect_true("No | Weighted 95% CI" %in% names(z$data))
  testthat::expect_true("Crude OR | Weighted" %in% names(z$data))
  testthat::expect_true("Crude OR 95% CI | Weighted" %in% names(z$data))
  testthat::expect_false(any(grepl("\\(95% CI\\) \\| Weighted$", names(z$data))))
})


testthat::test_that("bothstyle rows collapses weighted/unweighted columns correctly", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_rows_fixed",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(b2.sex, c.age, b2.smoking),
    design = "test_rows_fixed",
    result = "both",
    bothstyle = "rows",
    show = FALSE
  )

  testthat::expect_true("Analysis" %in% names(z$data))
  testthat::expect_true("Overall | n" %in% names(z$data))
  testthat::expect_true("Overall | Estimate" %in% names(z$data))
  testthat::expect_true("Overall | 95% CI" %in% names(z$data))
  testthat::expect_false(any(grepl("Unweighted|Weighted", names(z$data)[names(z$data) != "Analysis"])))
  testthat::expect_false(any(z$data$Characteristic %in% c("FALSE", "TRUE")))
})


testthat::test_that("summary method exposes table design tests and effects", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_summary",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi),
    by = hypertension,
    design = "test_summary",
    or = TRUE,
    show = FALSE
  )

  s <- summary(z)
  testthat::expect_true(is.list(s))
  testthat::expect_true(all(c("table", "design", "tests", "effects", "notes") %in% names(s)))
})


testthat::test_that("nested PSU count respects strata when PSU identifiers repeat", {
  d <- .make_r4vn_survey_test_data()
  s <- surveyset(
    d, name = "test_nested_psu_count",
    weight = wt, strata = strata, cluster = psu, nest = TRUE
  )

  ss <- summary(s)
  got <- ss$Value[ss$Item == "First-stage PSUs"]
  testthat::expect_identical(got, "48")
})


testthat::test_that("confidence level labels follow level instead of being hard-coded to 95 percent", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_ci_level",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi),
    by = hypertension,
    design = "test_ci_level",
    or = TRUE,
    event = "Yes",
    level = .90,
    show = FALSE
  )

  testthat::expect_true(any(grepl("90% CI", names(z$data), fixed = TRUE)))
  testthat::expect_false(any(grepl("95% CI", names(z$data), fixed = TRUE)))
  testthat::expect_equal(z$level, .90)
})


testthat::test_that("auto report keeps simple weighted output and adds supporting report tables", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_auto_report",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi),
    by = hypertension,
    design = "test_auto_report",
    show = FALSE
  )

  testthat::expect_identical(z$report, "auto")
  testthat::expect_identical(z$result, "weighted")
  testthat::expect_true(all(c("Main", "Design", "Tests") %in% names(z$tables)))
  testthat::expect_true(is.list(z$diagnostics))
  testthat::expect_true(is.data.frame(z$diagnostics$design))
  testthat::expect_true(is.data.frame(z$interpretation))
  testthat::expect_equal(nrow(z$interpretation), 0L)
  testthat::expect_true(grepl("Survey design", z$html, fixed = TRUE))
  testthat::expect_true(grepl("Statistical tests", z$html, fixed = TRUE))
})


testthat::test_that("full report turns on both rows SE DEFF and CV unless explicitly overridden", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_full_report_profile",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_full_report_profile",
    report = "full",
    show = FALSE
  )

  testthat::expect_identical(z$result, "both")
  testthat::expect_identical(z$bothstyle, "rows")
  testthat::expect_true("Analysis" %in% names(z$data))
  testthat::expect_true(any(grepl("\\| SE$", names(z$data))))
  testthat::expect_true(any(grepl("\\| DEFF$", names(z$data))))
  testthat::expect_true(any(grepl("\\| CV$", names(z$data))))
  testthat::expect_true("Precision" %in% names(z$tables))
  testthat::expect_true(grepl("Precision diagnostics", z$html, fixed = TRUE))
})


testthat::test_that("brief report suppresses automatic tests but respects explicit requests", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_brief_report",
    weight = wt, strata = strata, cluster = psu
  )

  z1 <- tabsurvey(
    vars = vars(c.age, b2.sex),
    by = hypertension,
    design = "test_brief_report",
    report = "brief",
    show = FALSE
  )
  testthat::expect_false("Tests" %in% names(z1$tables))

  z2 <- tabsurvey(
    vars = vars(c.age, b2.sex),
    by = hypertension,
    design = "test_brief_report",
    report = "brief",
    test = TRUE,
    show = FALSE
  )
  testthat::expect_true("Tests" %in% names(z2$tables))
})


testthat::test_that("interpretation is opt-in and provides cautious deterministic output", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_interpretation",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_interpretation",
    pr = TRUE,
    event = "Yes",
    multi = TRUE,
    interpretation = TRUE,
    show = FALSE
  )

  testthat::expect_true(is.data.frame(z$interpretation))
  testthat::expect_true(nrow(z$interpretation) >= 1L)
  testthat::expect_true(all(c("Section", "Item", "Interpretation") %in% names(z$interpretation)))
  testthat::expect_true("Interpretation" %in% names(z$tables))
  testthat::expect_true(grepl("Interpretation", z$html, fixed = TRUE))
})


testthat::test_that("reported regression models and result contract are exposed", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_contract_models",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_contract_models",
    or = TRUE,
    event = "Yes",
    multi = TRUE,
    show = FALSE
  )

  testthat::expect_true(all(c(
    "descriptive", "estimates", "tests", "diagnostics", "interpretation",
    "tables", "models", "metadata", "call"
  ) %in% names(z)))
  testthat::expect_true(length(z$models) >= 1L)
  testthat::expect_true(is.list(z$estimates))
  testthat::expect_true(is.data.frame(z$estimates$effects))
})



testthat::test_that("supporting Tests and Effects tables are formatted for end users", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_supporting_tables",
    weight = wt, strata = strata, cluster = psu
  )

  z <- tabsurvey(
    vars = vars(c.age, b2.sex, c.bmi, b2.smoking),
    by = hypertension,
    design = "test_supporting_tables",
    or = TRUE,
    event = "Yes",
    level = .90,
    show = FALSE
  )

  testthat::expect_true(all(c("Variable", "Analysis", "Test", "p-value") %in% names(z$tables$Tests)))
  testthat::expect_true(all(c(
    "Variable", "Level", "Analysis", "Model", "Effect", "Estimate",
    "90% CI", "p-value"
  ) %in% names(z$tables$Effects)))
  testthat::expect_true(all(c("variable", "analysis", "method", "p") %in% names(z$tests)))
  testthat::expect_true(all(c("variable", "stage", "estimate", "lower", "upper") %in% names(z$effects)))
})


# Regression test for the 2026-09-02 report-profile bug:
# `provided` is a named logical vector, so `$` is invalid for access.
testthat::test_that("report profile accepts named logical vectors", {
  provided <- c(
    result = FALSE, bothstyle = FALSE,
    descriptive = FALSE, test = FALSE,
    pvalue = FALSE, se = FALSE, deff = FALSE,
    cv = FALSE, test_note = FALSE
  )

  z <- .r4vn_sv_profile(
    report = "auto",
    provided = provided,
    by_info = NULL,
    outcome_type = NULL,
    result = "weighted",
    bothstyle = "columns",
    descriptive = TRUE,
    test = TRUE,
    pvalue = TRUE,
    se = FALSE,
    deff = FALSE,
    cv = FALSE,
    test_note = TRUE
  )

  testthat::expect_identical(z$report, "auto")
  testthat::expect_identical(z$result, "weighted")
  testthat::expect_true(z$descriptive)
  testthat::expect_false(z$test)
})


testthat::test_that("simplest end-user auto-profile calls do not fail", {
  d <- .make_r4vn_survey_test_data()
  surveyset(
    d, name = "test_profile_regression",
    weight = wt, strata = strata, cluster = psu
  )

  testthat::expect_no_error({
    z1 <- tabsurvey(
      vars = vars(c.age, sex, c.bmi, smoking, hypertension),
      design = "test_profile_regression",
      show = FALSE
    )
  })

  testthat::expect_no_error({
    z2 <- tabsurvey(
      vars = vars(c.age, q.bmi, sex, smoking),
      design = "test_profile_regression",
      title = "Survey descriptive statistics",
      show = FALSE
    )
  })
})