tests/testthat/test-ard_mvsummary.R

In cards: Analysis Results Data

test_that("ard_mvsummary() works", {
  # we can replicate `ard_summary()` for univariate analysis
  # using the `x` arg in the mean function
  expect_equal(
    ard_mvsummary(
      ADSL,
      by = "ARM",
      variables = "AGE",
      statistic = list(AGE = list(mean = \(x, ...) mean(x)))
    ) |>
      dplyr::select(all_ard_groups(), all_ard_variables(), stat),
    ard_summary(
      ADSL,
      by = "ARM",
      variables = "AGE",
      statistic = ~ continuous_summary_fns("mean")
    ) |>
      dplyr::select(all_ard_groups(), all_ard_variables(), stat)
  )

  # using the `data` and `variable` args in the mean function
  expect_equal(
    ard_mvsummary(
      ADSL,
      by = "ARM",
      variables = "AGE",
      statistic = list(AGE = list(mean = \(data, variable, ...) mean(data[[variable]])))
    ) |>
      dplyr::select(all_ard_groups(), all_ard_variables(), stat),
    ard_summary(
      ADSL,
      by = "ARM",
      variables = "AGE",
      statistic = ~ continuous_summary_fns("mean")
    ) |>
      dplyr::select(all_ard_groups(), all_ard_variables(), stat)
  )

  # test a function using `data` and `full_data` arguments
  expect_error(
    {
      grand_mean <- function(data, full_data, variable, ...) {
        list(
          mean = mean(data[[variable]], na.rm = TRUE),
          grand_mean = mean(full_data[[variable]], na.rm = TRUE)
        )
      }
      ard_grand_mean <-
        ard_mvsummary(
          ADSL,
          by = "ARM",
          variables = "AGE",
          statistic = list(AGE = list(means = grand_mean))
        ) |>
        as.data.frame() |>
        dplyr::select(all_ard_groups(), all_ard_variables(), stat_name, stat)
    },
    NA
  )
  expect_equal(
    ard_grand_mean |>
      dplyr::filter(stat_name %in% "grand_mean") |>
      dplyr::pull(stat) |>
      unique() |>
      getElement(1L),
    mean(ADSL$AGE)
  )
  expect_equal(
    ard_grand_mean |>
      as.data.frame() |>
      dplyr::filter(stat_name %in% "mean") |>
      dplyr::mutate(across(c(group1_level, stat), unlist)) |>
      dplyr::select(group1_level, stat),
    ADSL |>
      dplyr::summarise(
        .by = "ARM",
        stat = mean(AGE)
      ) |>
      dplyr::rename(group1_level = ARM) |>
      as.data.frame(),
    ignore_attr = TRUE
  )
})

test_that("ard_mvsummary() messaging", {
  # correct messaging when BMIBL doesn't have any summary fns
  expect_snapshot(
    error = TRUE,
    ard_mvsummary(
      ADSL,
      by = "ARM",
      variables = c("AGE", "BMIBL"),
      statistic = list(AGE = list(mean = \(x, ...) mean(x)))
    )
  )
})

test_that("ard_mvsummary() with grouped data works", {
  expect_equal(
    ADSL |>
      dplyr::group_by(ARM) |>
      ard_mvsummary(
        variables = c("AGE", "BMIBL"),
        statistic = ~ list(mean = \(x, ...) mean(x))
      ),
    ard_mvsummary(
      data = ADSL,
      by = "ARM",
      variables = c("AGE", "BMIBL"),
      statistic = ~ list(mean = \(x, ...) mean(x))
    )
  )
})


test_that("ard_mvsummary() follows ard structure", {
  expect_silent(
    ard_mvsummary(
      ADSL,
      by = "ARM",
      variables = "AGE",
      statistic = list(AGE = list(mean = \(x, ...) mean(x)))
    ) |>
      check_ard_structure(method = FALSE)
  )
})

test_that("ard_mvsummary() errors with incorrect factor columns", {
  # Check error when factors have no levels
  expect_snapshot(
    error = TRUE,
    mtcars |>
      dplyr::mutate(am = factor(am, levels = character(0))) |>
      ard_mvsummary(
        by = "am",
        variables = "mpg",
        statistic = list(mpg = list(mean = \(x, ...) mean(x)))
      )
  )

  # Check error when factor has NA level
  expect_snapshot(
    error = TRUE,
    mtcars |>
      dplyr::mutate(am = factor(am, levels = c(0, 1, NA), exclude = NULL)) |>
      ard_mvsummary(
        by = "am",
        variables = "mpg",
        statistic = list(mpg = list(mean = \(x, ...) mean(x)))
      )
  )
})

test_that("ard_mvsummary() with `as_cards_fn()` inputs", {
  ttest_works <-
    as_cards_fn(
      \(x, data, ...) t.test(x ~ data$am)[c("statistic", "p.value")],
      stat_names = c("statistic", "p.value")
    )
  ttest_error <-
    as_cards_fn(
      \(x, data, ...) {
        t.test(x ~ data$am)[c("statistic", "p.value")]
        stop("Intentional Error")
      },
      stat_names = c("statistic", "p.value")
    )

  # the result is the same when there is no error
  expect_equal(
    ard_mvsummary(mtcars, variables = mpg, statistic = ~ list(ttest = ttest_works)),
    ard_mvsummary(mtcars, variables = mpg, statistic = ~ list(ttest = \(x, data, ...) t.test(x ~ data$am)[c("statistic", "p.value")]))
  )

  # when there is an error, we get the same structure back
  expect_equal(
    ard_mvsummary(mtcars, variables = mpg, statistic = ~ list(ttest = ttest_error)) |>
      dplyr::pull("stat_name"),
    ard_mvsummary(mtcars, variables = mpg, statistic = ~ list(ttest = \(x, data, ...) t.test(x ~ data$am)[c("statistic", "p.value")])) |>
      dplyr::pull("stat_name")
  )
})