# 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, "dim")[1], n_sim ) # assessDesign result (in this base case) should have crit_prob = 1 - alpha_crit_val expect_equal( attr(eval_design$linear, "critProb"), 1 - alpha_crit_val ) contr_mat <- getContr( mods = mods, dose_levels = dose_levels, dose_weights = n_patients, prior_list = prior_list ) 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, modeling = TRUE ) ) # 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, "critProb"), 1 - alpha_crit_val ) expect_no_error( 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, reestimate = TRUE, contr = contr_mat ) ) sd_tot <- 9.4 dose_levels <- c(0, 2.5, 5, 10, 20) prior_list <- lapply(dose_levels, function(dose_group) { RBesT::mixnorm(weak = c(w = 1, m = 0, s = 200), sigma = 10) }) names(prior_list) <- c("Ctr", paste0("DG_", dose_levels[-1])) exp <- DoseFinding::guesst( d = 5, p = c(0.2), model = "exponential", Maxd = max(dose_levels) ) emax <- DoseFinding::guesst( d = 2.5, p = c(0.9), model = "emax" ) sigemax <- DoseFinding::guesst( d = c(2.5, 5), p = c(0.1, 0.6), model = "sigEmax" ) sigemax2 <- DoseFinding::guesst( d = c(2, 4), p = c(0.3, 0.8), model = "sigEmax" ) mods <- DoseFinding::Mods( linear = NULL, emax = emax, exponential = exp, sigEmax = rbind(sigemax, sigemax2), doses = dose_levels, maxEff = -3, placEff = -12.8 ) n_patients <- c(60, 80, 80, 80, 80) expect_no_error( assessDesign( n_patients = n_patients, mods = mods, prior_list = prior_list, sd = sd_tot, n_sim = 10, reestimate = TRUE ) ) }) ### 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" ) }) test_that("getContrMat works as expected", { cov_posterior <- diag(sd^2) contr_mat_post_sd <- getContr( mods = mods, dose_levels = dose_levels, cov_posterior = cov_posterior ) se_new_trial <- c(0.3, 0.7, 0.9, 2.1) se_new_trial <- se_new_trial[1:2] contr_mat_se_new <- getContr( mods = mods, dose_levels = dose_levels, cov_new_trial = diag(se_new_trial^2) ) # Length mismatch for se_new_trial should error expect_error( getContr( mods = mods, dose_levels = dose_levels, se_new_trial = se_new_trial[-1] ) ) expect_s3_class( contr_mat_post_sd, "optContr" ) expect_no_error(contr_mat_post_sd) expect_s3_class( contr_mat_se_new, "optContr" ) expect_no_error(contr_mat_se_new) expect_error( getContr( mods = mods, dose_levels = dose_levels ) ) }) # 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, "critProbAdj") == crit_pval ) expect_type( attr(b_mcp, "essAvg"), "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 attaches flags per model and validates input length", { addSignificance_fn <- tryCatch( getFromNamespace("addSignificance", "BayesianMCPMod"), error = function(e) NULL ) skip_if(is.null(addSignificance_fn), "addSignificance not exported/available") models <- c("emax", "linear") dose_levels <- c(0, 1, 2, 4, 8) # Strongly convex pattern: tiny effects at low/mid doses, big jump at the top dose. posterior_list <- list( Ctrl = RBesT::mixnorm(comp1 = c(w = 1, m = 0.0, s = 0.7), sigma = 1.2), DG_1 = RBesT::mixnorm(comp1 = c(w = 1, m = 0.6, s = 0.7), sigma = 1.2), DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 1.4, s = 0.7), sigma = 1.2), DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 3.4, s = 0.7), sigma = 1.2), DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 7.8, s = 0.7), sigma = 1.2) ) fit <- getModelFits( models = models, posterior = posterior_list, dose_levels = dose_levels ) # Flags length matches -> flags should be attached per entry out <- addSignificance_fn(fit, c(TRUE, FALSE)) expect_true(is.list(out) && all(names(out) == names(fit))) expect_false(out$linear$significant.linear) expect_false(out$emax$significant.emax) # Mismatched length should raise an error expect_error(addSignificance_fn(fit, list(TRUE))) })