tests/testthat/test-tbl_cross.R

In gtsummary: Presentation-Ready Data Summary and Analytic Result Tables

skip_on_cran()

trial2 <- rbind(
  NA, # For missing stats
  trial[, c(1, 4)] # Useful for not specifying row and col
)

# tbl_cross(data) --------------------------------------------------------------
test_that("tbl_cross(data) works", {
  expect_snapshot(tbl_cross(trial2) |> as.data.frame()) # First and second cols
})

test_that("tbl_cross(data) errors properly", {
  # Errors thrown when bad data argument passed
  expect_snapshot(error = TRUE, tbl_cross())
  expect_snapshot(error = TRUE, tbl_cross(data = letters))
  expect_snapshot(error = TRUE, tbl_cross(data = dplyr::tibble()))
  expect_snapshot(error = TRUE, tbl_cross(data = data.frame()))
})

# tbl_cross(row, col) ----------------------------------------------------------
test_that("tbl_cross(row, col) works", {
  expect_snapshot(tbl_cross(trial, row = trt, col = grade) |> as.data.frame())
})

test_that("tbl_cross(row, col) errors properly", {
  # Errors thrown when bad row or col argument passed
  expect_snapshot(error = TRUE, tbl_cross(trial, row = trt))
  expect_snapshot(error = TRUE, tbl_cross(trial |> mutate("..total.." = 1), row = "..total..", col = trt))
  expect_snapshot(error = TRUE, tbl_cross(trial, col = trt))
  expect_snapshot(error = TRUE, tbl_cross(trial, row = trt, col = 1))
  expect_snapshot(error = TRUE, tbl_cross(trial, row = NULL, col = grade))
})

# tbl_cross(label) ----------------------------------------------------------
test_that("tbl_cross(label) works", {
  expect_silent(
    out <- tbl_cross(
      trial2,
      label = list(trt = "TRT", stage = "STAGE")
    )
  )
  expect_identical(out$table_body$var_label[1], "TRT")
  expect_identical(unique(out$table_styling$spanning_header$spanning_header), "STAGE")
})

test_that("tbl_cross(label) errors properly", {
  # Errors thrown when bad label argument passed
  expect_snapshot(
    error = TRUE,
    tbl_cross(trial2, label = list(trt = letters))
  )

  expect_snapshot(
    error = TRUE,
    tbl_cross(trial2, label = letters)
  )

  expect_snapshot(
    error = TRUE,
    tbl_cross(trial2, label = TRUE)
  )

  expect_snapshot(
    error = TRUE,
    tbl_cross(trial2, label = list(trt = NA))
  )
})

# tbl_cross(statistic) ---------------------------------------------------------
all_stats <- c("p", "n", "N", "N_miss", "N_nonmiss", "p_miss", "p_nonmiss") |>
  sapply(function(var) sprintf("%s={%s}", var, var)) |>
  paste(collapse = " | ")

test_that("tbl_cross(statistic) works", {
  expect_silent(
    out <- tbl_cross(trial2,
              statistic = all_stats)
  )
  expect_equal(
    out$table_body$stat_0[4],
    "p=0.5 | n=1 | N=201 | N_miss=0 | N_nonmiss=201 | p_miss=0 | p_nonmiss=100" # n = 1 is unknown (missing)
  )
})

# tbl_cross(margin) ------------------------------------------------------------
test_that("tbl_cross(margin) works", {
  expect_snapshot(tbl_cross(trial2, margin = "column") |> as.data.frame())
})

test_that("tbl_cross(margin) errors properly", {
  expect_snapshot(error = TRUE, tbl_cross(trial2, margin = "columsadasn"))
  expect_snapshot(error = TRUE, tbl_cross(trial2, margin = 1))
})

# tbl_cross(percent) -----------------------------------------------------------
test_that("tbl_cross(percent) works", {
  expect_silent(out <- tbl_cross(trial2, percent = "row"))
  expect_true(all(grepl(out$table_body$stat_0[-1], pattern = "\\(100\\%\\)")))

  expect_silent(out <- tbl_cross(trial2, percent = "cell"))
  expect_true(grepl(out$table_body$stat_0[5], pattern = "\\(100\\%\\)"))

  expect_silent(out <- tbl_cross(trial2, percent = "column"))
  expect_true(all(grepl(out$table_body[5, -seq(5)] |> unlist(use.names = FALSE), pattern = "\\(100\\%\\)")))
})

test_that("tbl_cross(percent) errors properly", {
  expect_snapshot(error = TRUE, tbl_cross(trial2, percent = "columsadasn"))
  expect_snapshot(error = TRUE, tbl_cross(trial2, percent = 1))
})

# tbl_cross(digits) -----------------------------------------------------------
test_that("tbl_cross(digits) works", {
  # ensuring the proper formatting is passed along
  expect_snapshot(
    tbl_cross(
      rep(list(trial), 11L) |> dplyr::bind_rows(),
      row       = grade,
      col       = trt,
      statistic = "{n}/{N_nonmiss}/{N} ({p}%)",
      digits    = c(0, 0, 0, 4)
    ) |>
      as.data.frame()
  )
})