tests/testthat/test-binary-med.R

In BayesianMCPMod: Simulate, Evaluate, and Analyze Dose Finding Trials with Bayesian MCPMod

test_that("getMED: probability scale enforces delta bounds and returns expected structure", {
  skip_if_not_installed("RBesT")
  skip_if_not_installed("DoseFinding")
  skip_if_not_installed("dplyr")
  skip_if_not_installed("tidyr")
  
  set.seed(13)
  
  dose_levels <- c(0, 1, 2, 4)
  probs <- c(0.10, 0.18, 0.28, 0.45)
  
  mu_hat <- qlogis(probs)
  se_hat <- rep(0.40, length(dose_levels))
  
  prior_list <- setNames(
    lapply(seq_along(dose_levels), function(i) {
      RBesT::mixnorm(comp1 = c(w = 1, m = mu_hat[i], s = 1.2), sigma = 2)
    }),
    c("Ctr", paste0("DG_", seq_along(dose_levels[-1])))
  )
  
  post <- getPosterior(
    prior_list        = prior_list,
    mu_hat            = mu_hat,
    S_hat             = diag(se_hat^2),
    probability_scale = TRUE
  )
  
  mods <- DoseFinding::Mods(
    linear = NULL,
    emax   = c(0.5, 1.2),
    doses  = dose_levels,
    maxEff = 2
  )
  
  fits <- getModelFits(
    models            = mods,
    dose_levels       = dose_levels,
    posterior         = post,
    simple            = TRUE,
    avg_fit           = TRUE,
    probability_scale = TRUE
  )
  
  # delta bounds on probability scale
  expect_error(getMED(delta = 1.5, model_fits = fits, probability_scale = TRUE))
  expect_error(getMED(delta = -0.1, model_fits = fits, probability_scale = TRUE))
  
  med <- getMED(delta = 0.10, model_fits = fits, probability_scale = TRUE)
  expect_true(is.matrix(med))
  expect_equal(rownames(med), c("med_reached", "med"))
  expect_true(all(colnames(med) %in% names(fits)))
  
  # Bootstrap path
  bq <- getBootstrapQuantiles(
    model_fits        = fits,
    quantiles         = c(0.2, 0.8),
    n_samples         = 80,
    doses             = dose_levels,
    probability_scale = TRUE
  )
  
  med2 <- getMED(
    delta             = 0.10,
    evidence_level    = 0.8,
    bs_quantiles      = bq,
    probability_scale = TRUE
  )
  expect_true(is.matrix(med2))
  expect_equal(rownames(med2), c("med_reached", "med"))
})