tests/testthat/test-BMCPMod.R

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

##########################
# Tests for assessDesign #
##########################

test_that("base case input throws no error and has correct properties", {
  
  expect_no_error(
    eval_design <- assessDesign(
      n_patients = n_patients, 
      mods = mods, 
      sd = sd,
      prior_list = prior_list,
      n_sim = n_sim,
      alpha_crit_val = alpha_crit_val,
      simple = TRUE
    )
  )
  
  # assessDesign should give results for each model in mods
  expect_equal(
    names(eval_design), names(mods)
  )
  
  # assessDesign result should have rows = n_sim
  expect_equal(
    attr(eval_design$linear$BayesianMCP, "dim")[1],
    n_sim
  )
  
  # assessDesign result (in this base case) should have crit_prob = 1 - alpha_crit_val
  expect_equal(
    attr(eval_design$linear$BayesianMCP, "crit_prob"),
    1 - alpha_crit_val
  )
  
})


### n_patients param ###

test_that("assessDesign validates n_patients parameter input and give appropriate error messages", {
  
  # assertions that aren't tested here for sake of brevity
    # n_patients should be a non-NULL numeric vector
  
  expect_error(
    assessDesign(n_patients = n_patients[-1], sd = sd, mods = mods, prior_list = prior_list, n_sim = n_sim)
  )
  
  expect_error(
    assessDesign(n_patients = rep(1, length(n_patients)), sd = sd, mods = mods, prior_list = prior_list, n_sim = n_sim),
  )
})

### mods param ###

test_that("assessDesign validates mods parameter input and give appropriate error messages", {
  
  # assertions that aren't tested here for sake of brevity
    # mods should be non-NULL object of class "Mods" from {DoseFinding}
  
  
  # checking that DoseFinding didn't change how they named their 'doses' attribute
  expect_true(
    "doses" %in% names(attributes(mods))
  )
  
  mods2 <- mods
  attr(mods2, "doses") <- 0
  expect_error(
    assessDesign(n_patients = n_patients, mods = mods2, sd = sd, prior_list = prior_list, n_sim = n_sim)
  )
  rm(mods2)
  
})

## prior_list param ###

test_that("assessDesign validates prior_list parameter input and give appropriate error messages", {
  
  # assertions that aren't tested here for sake of brevity
    # prior_list should be a non-NULL named list with length = number of dose levels
    # length(attr(prior_list, "dose_levels")) == n_patients (see above)
  
  # checking that we didn't change how we named the 'dose_levels' attribute
  expect_true(
    "doses" %in% names(attributes(mods))
  )
  
})

#########################
# Tests for getCritProb #
#########################

# getCritProb relies on DoseFinding, which we assumes works correctly, so the tests here are minimal

test_that("getCritProb returns the right type of value under normal case", {
  
  crit_pval = getCritProb(
    mods = mods, 
    dose_levels = dose_levels, 
    dose_weights = n_patients, 
    alpha_crit_val = alpha_crit_val
  )

  expect_type(
    crit_pval, "double"
  )

  expect_true(
    crit_pval >= 0 & crit_pval <= 1
  )

})

#########################
# Tests for getContrMat #
#########################

# getContrMat relies on DoseFinding, which we assumes works correctly, so the tests here are minimal

test_that("getContrMat returns the right type of object under normal case", {
  
  contr_mat = getContr(
    mods = mods, 
    dose_levels = dose_levels, 
    dose_weights = n_patients,
    prior_list = prior_list
  )

  expect_s3_class(
    contr_mat, "optContr"
  )

})

################################
# Tests for performBayesianMCP #
################################

test_that("performBayesianMCP returns the right type of object under normal case", {
  
  data <- simulateData(
    n_patients  = n_patients,
    dose_levels = dose_levels,
    sd          = sd,
    mods        = mods,
    n_sim       = n_sim
  )

  posterior_list <- getPosterior(
    data = getModelData(data, names(mods)[1]),
    prior_list = prior_list
  )
  
  contr_mat = getContr(
    mods = mods, 
    dose_levels = dose_levels, 
    dose_weights = n_patients,
    prior_list = prior_list
  )
  
  crit_pval = getCritProb(
    mods = mods, 
    dose_levels = dose_levels, 
    dose_weights = n_patients, 
    alpha_crit_val = alpha_crit_val
  )

  b_mcp <- performBayesianMCP(
    posterior_list = posterior_list,
    contr = contr_mat,
    crit_prob_adj = crit_pval
  )

  expect_s3_class(
    b_mcp,
    "BayesianMCP"
  )

  expect_true(
    attr(b_mcp, "crit_prob_adj") == crit_pval
  )
  
  expect_type(
    attr(b_mcp, "ess_avg"), "logical"
  )

  expect_type(
    attr(b_mcp, "successRate"), "double"
  )
  
  
  expect_type(b_mcp, "double")
  
})

###################################
# Tests for performBayesianMCPMod #
###################################

test_that("performBayesianMCPMod returns the right type of object under normal case", {
  
  b_mcp_mod <- performBayesianMCPMod(
    posterior_list = posterior_list,
    contr = contr_mat,
    crit_prob_adj = crit_pval
  )

  expect_s3_class(
    b_mcp_mod,
    "BayesianMCPMod"
  )

  expect_true(
    all(names(b_mcp_mod) == c("BayesianMCP", "Mod"))
  )
  
})


#############################
# Tests for addSignificance #
#############################

test_that("addSignificance works as intended", {
  model_fits  <- list(linear = 1)

  model_fits_with_sign = addSignificance(model_fits, list(TRUE))
  expect_true(
    model_fits_with_sign[[1]][["significant"]]
  )

  model_fits_with_sign = addSignificance(model_fits, list(FALSE))
  expect_false(
    model_fits_with_sign[[1]]$significant
  )
})

#######################
# Tests for BayesMCPi #
#######################

# test_that("BayesMCPi function works correctly in a simple case", {
# 
#   # BayesMCPi should return a list of length 3 named with "sign", "p_val", and "post_probs"
#   # The logic being tested here is: 
#     # BayesMCPi returns 1 if the posterior probability is strictly greater than the critical value, and 0 otherwise
#   
#   # Define inputs
#   posterior_i = posterior_list
#   contr_mat = list(contMat = matrix(c(0, 1), nrow = 2))
#   crit_prob = 0.5
#   
#   # Call the function
#   result = BayesMCPi(posterior_i, contr_mat, crit_prob)
#   # Check the results
#   expect_equal(result[["sign"]], 1)
#   
#   # Define inputs
#   contr_mat = list(contMat = matrix(c(0, 0), nrow = 2))
#   # Call the function
#   result = BayesMCPi(posterior_i, contr_mat, crit_prob)
#   # Check the results
#   expect_equal(result[["sign"]], rep(NA_real_, 1))
# 
# #   # Define inputs
# #   contr_mat_2 = list(contMat = matrix(c(1, 0), nrow = 2))
# #   # Call the function
# #   result_2 = BayesMCPi(posterior_i, contr_mat_2, crit_prob)
# #   # Check the results
# #   expect_equal(result_2[["sign"]], 0)
# })

#########################
# Tests for getPostProb #
#########################

# Test for getPostProb
test_that("getPostProb works correctly in a simple case", {
  # Create a test case
  contr_j <- c(1, 1)
  post_combs_i <- list(
    means = matrix(c(0, 0, 1, 1), nrow = 2),
    vars = matrix(c(0, 0, 1, 1), nrow = 2),
    weights = c(0.5, 0.5)
  )
  # Call the function with the test case
  result <- getPostProb(
    contr_j, 
    post_combs_i
  )
  # Assert the expected behavior
  expect_equal(result, stats::pnorm(1))
})