tests/testthat/test-testing.R

In openpharma/mmrm: Mixed Models for Repeated Measures

# df_1d ----

test_that("df_1d uses correct function on Satterthwaite method fit", {
  object <- get_mmrm()
  contrast <- rep(0, length(object$beta_est))
  contrast[3] <- 1
  expect_identical(df_1d(object, contrast), h_df_1d_sat(object, contrast))
})

test_that("df_1d uses correct function on Kenward-Roger method fit", {
  object_kr <- get_mmrm_kr()
  contrast <- rep(0, length(object_kr$beta_est))
  contrast[2] <- 1
  expect_identical(df_1d(object_kr, contrast), h_df_1d_kr(object_kr, contrast))
})

test_that("df_1d uses correct function on Between-Within method fit", {
  object <- get_mmrm_bw()
  contrast <- rep(0, length(object$beta_est))
  contrast[2] <- 1
  expect_identical(df_1d(object, contrast), h_df_1d_bw(object, contrast))
})

# df_md ----

test_that("df_md uses correct function on Satterthwaite method fit", {
  object <- get_mmrm()
  contrast_md <- matrix(0, nrow = 2, ncol = length(object$beta_est))
  contrast_md[2, 1] <- 1
  contrast_md[1, 3] <- 1
  expect_identical(df_md(object, contrast_md), h_df_md_sat(object, contrast_md))
})

test_that("df_md uses correct function on Kenward-Roger method fit", {
  object_kr <- get_mmrm_kr()
  contrast_md <- matrix(0, nrow = 2, ncol = length(object_kr$beta_est))
  contrast_md[2, 1] <- 1
  contrast_md[1, 2] <- 1
  expect_identical(df_md(object_kr, contrast_md), h_df_md_kr(object_kr, contrast_md))
})

test_that("df_md uses correct function on Kenward-Roger-Linear method fit", {
  object_kr <- get_mmrm_krl()
  contrast_md <- matrix(0, nrow = 2, ncol = length(object_kr$beta_est))
  contrast_md[2, 1] <- 1
  contrast_md[1, 2] <- 1
  expect_identical(df_md(object_kr, contrast_md), h_df_md_kr(object_kr, contrast_md))
})

test_that("df_md uses correct function on Between-Within method fit", {
  object_bw <- get_mmrm_bw()
  contrast_md <- matrix(0, nrow = 2, ncol = length(object_bw$beta_est))
  contrast_md[2, 1] <- 1
  contrast_md[1, 2] <- 1
  expect_identical(df_md(object_bw, contrast_md), h_df_md_bw(object_bw, contrast_md))
})

test_that("df_md return df=0 and other stat all NA if empty matrix provided", {
  object_bw <- get_mmrm_bw()
  contrast_md <- matrix(0, nrow = 0, ncol = length(object_bw$beta_est))
  expect_identical(
    df_md(object_bw, contrast_md),
    list(num_df = 0, denom_df = NA_real_, f_stat = NA_real_, p_val = NA_real_)
  )
})

# h_test_1d ----

test_that("h_test_1d works as expected", {
  object <- get_mmrm()
  contrast <- rep(0, length(object$beta_est))
  contrast[3] <- 1
  df <- 3.5

  result <- expect_silent(h_test_1d(object, contrast, df))
  expect_list(result)
  expect_named(result, c("est", "se", "df", "t_stat", "p_val"))
  expect_snapshot_tolerance(result)
})

# h_test_md ----

test_that("h_test_md works as expected", {
  object <- get_mmrm()
  contrast_md <- matrix(0, nrow = 2, ncol = length(object$beta_est))
  contrast_md[2, 1] <- 1
  contrast_md[1, 3] <- 1
  df <- 5

  result <- expect_silent(h_test_md(object, contrast_md, df))
  expect_list(result)
  expect_named(result, c("num_df", "denom_df", "f_stat", "p_val"))
  expect_snapshot_tolerance(result)
})