diff --git a/tests/testthat/test-modelling.R b/tests/testthat/test-modelling.R new file mode 100644 index 0000000..2de1ba4 --- /dev/null +++ b/tests/testthat/test-modelling.R @@ -0,0 +1,27 @@ +# Test data +test_data <- data.frame( + simulation = rep(1, 6), + dose = c(0, 1, 2, 3, 4, 5), + response = c(0, 1, 2, 3, 4, 5) +) + +# Mock getPosterior function +getPosterior <- function(data, prior_list, mu_hat, sd_hat) { + list( + means = c(0, 1, 2, 3, 4, 5), + vars = c(1, 1, 1, 1, 1, 1), + weights = c(1, 1, 1, 1, 1, 1) + ) +} + +# Test predictModelFit function +test_that("predictModelFit works correctly", { + model_fit <- list( + model = "emax", + coeffs = c(e0 = 0, eMax = 1, ed50 = 2), + dose_levels = c(0, 1, 2, 3, 4, 5) + ) + + pred_vals <- predictModelFit(model_fit) + expect_is(pred_vals, "numeric") +}) diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R new file mode 100644 index 0000000..bd33665 --- /dev/null +++ b/tests/testthat/test-plot.R @@ -0,0 +1,175 @@ +# Additional test cases for plot_modelFits function + +test_that("Test plot_modelFits with different model_fits input", { + + library(BayesianMCPMod) + library(clinDR) + library(dplyr) + + data("metaData") + testdata <- as.data.frame(metaData) + dataset <- filter(testdata, bname == "VIAGRA") + histcontrol <- filter(dataset, dose == 0, primtime == 12, indication == "ERECTILE DYSFUNCTION") + + ## Create MAP Prior + hist_data <- data.frame( + trial = c(1, 2, 3, 4), + est = histcontrol$rslt, + se = histcontrol$se, + sd = histcontrol$sd, + n = histcontrol$sampsize + ) + + sd_tot <- with(hist_data, sum(sd * n) / sum(n)) + + + gmap <- RBesT::gMAP( + formula = cbind(est, se) ~ 1 | trial, + weights = hist_data$n, + data = hist_data, + family = gaussian, + beta.prior = cbind(0, 100 * sd_tot), + tau.dist = "HalfNormal", + tau.prior = cbind(0, sd_tot / 4) + ) + + prior_ctr <- RBesT::robustify( + priormix = RBesT::automixfit(gmap), + weight = 0.5, + mean = 1.4, + sigma = sd_tot + ) + + # RBesT::ess(prior_ctr) + + ## derive prior for treatment + ## weak informative using same parameters as for robustify component + prior_trt <- RBesT::mixnorm( + comp1 = c(w = 1, m = 1.4, n = 1), + sigma = sd_tot, + param = "mn" + ) + dose_levels <- c(0, 50, 100, 200) + ## combine priors in list + prior_list <- c(list(prior_ctr), rep(list(prior_trt), times = length(dose_levels[-1]))) + + # Pre-Specification (B)MCPMod + + ## candidate models for MCPMod + # linear function - no guestimates needed + exp <- DoseFinding::guesst( + d = 50, + p = c(0.2), + model = "exponential", + Maxd = max(dose_levels) + ) + emax <- DoseFinding::guesst( + d = 100, + p = c(0.9), + model = "emax" + ) + + + mods <- DoseFinding::Mods( + linear = NULL, + emax = emax, + exponential = exp, + doses = dose_levels, + maxEff = 10, + placEff = 1.4 + ) + + # Simulation of new trial + ## Note: This part will be simplified and direct results from one trial will be used + mods_sim <- DoseFinding::Mods( + emax = emax, + doses = dose_levels, + maxEff = 12, + placEff = 1.4 + ) + + n_patients <- c(50, 50, 50, 50) + data <- simulateData( + n_patients = n_patients, + dose_levels = dose_levels, + sd = sd_tot, + mods = mods_sim, + n_sim = 1 + ) + + data_emax <- data[, c("simulation", "dose", "emax")] + names(data_emax)[3] <- "response" + + posterior_emax <- getPosterior( + data = data_emax, + prior_list = prior_list + ) + + # Evaluation of Bayesian MCPMod + + contr_mat <- DoseFinding::optContr( + models = mods, + doses = dose_levels, + w = n_patients + ) + ## Calculation of critical value can be done with critVal function + crit_val_equal <- DoseFinding:::critVal(contr_mat$corMat, alpha = 0.05, df = 0, alternative = "one.sided") + crit_pval <- pnorm(crit_val_equal) + + ess_prior <- round(unlist(lapply(prior_list, RBesT::ess))) + + ### Evaluation of Bayesian MCPMod + contr_mat_prior <- DoseFinding::optContr( + models = mods, + doses = dose_levels, + w = n_patients + ess_prior + ) + + BMCP_result <- BMCPMod( + posteriors_list = list(posterior_emax), + contr_mat = contr_mat_prior, + crit_prob = crit_pval + ) + + # Model fit + # This part is currently not working + post_observed <- posterior_emax + model_shapes <- c("linear", "emax", "exponential") + + + # Option a) Simplified approach by using frequentist idea + fit_simple <- getModelFits( + models = model_shapes, + dose_levels = dose_levels, + posterior = post_observed, + simple = TRUE + ) + + # Option b) Making use of the complete posterior distribution + fit <- getModelFits( + models = model_shapes, + dose_levels = dose_levels, + posterior = post_observed, + simple = FALSE + ) + + # Test with default parameters and more models + plot6 <- plot_modelFits(fit) + expect_is(plot6, "ggplot") + + # Test with CrI = TRUE and more models + plot7 <- plot_modelFits(fit, CrI = TRUE) + expect_is(plot7, "ggplot") + + # Test with gAIC = FALSE and more models + plot8 <- plot_modelFits(fit, gAIC = FALSE) + expect_is(plot8, "ggplot") + + # Test with avg_fit = FALSE and more models + plot9 <- plot_modelFits(fit, avg_fit = FALSE) + expect_is(plot9, "ggplot") + + # Test with all non-default parameters and more models + plot10 <- plot_modelFits(fit, CrI = TRUE, gAIC = FALSE, avg_fit = FALSE) + expect_is(plot10, "ggplot") +}) \ No newline at end of file diff --git a/tests/testthat/test-posterior.R b/tests/testthat/test-posterior.R new file mode 100644 index 0000000..e089f9a --- /dev/null +++ b/tests/testthat/test-posterior.R @@ -0,0 +1,41 @@ +test_that("getPosterior works correctly", { + # Prepare test data and parameters + data <- data.frame(simulation = rep(1, 4), + dose = c(0, 1, 2, 3), + response = c(10, 20, 30, 40)) + prior_list <- list(1, 2, 3, 4) + mu_hat <- c(10, 20, 30, 40) + sd_hat <- matrix(c(1, 2, 3, 4), nrow = 4, ncol = 1) + + # Test getPosterior function + posterior_list <- getPosterior(data, prior_list, mu_hat, sd_hat) + expect_is(posterior_list, "postList") +}) + +test_that("getPosteriorI works correctly", { + # Prepare test data and parameters + data_i <- data.frame(dose = c(0, 1, 2, 3), + response = c(10, 20, 30, 40)) + prior_list <- list(1, 2, 3, 4) + mu_hat <- c(10, 20, 30, 40) + sd_hat <- matrix(c(1, 2, 3, 4), nrow = 4, ncol = 1) + + # Test getPosteriorI function + post_list <- getPosteriorI(data_i, prior_list, mu_hat, sd_hat) + expect_is(post_list, "postList") +}) + +test_that("summary.postList works correctly", { + # Prepare test data + post_list <- list( + Ctr = matrix(c(0.25, 10, 1), nrow = 3, ncol = 1), + DG_1 = matrix(c(0.25, 20, 2), nrow = 3, ncol = 1), + DG_2 = matrix(c(0.25, 30, 3), nrow = 3, ncol = 1), + DG_3 = matrix(c(0.25, 40, 4), nrow = 3, ncol = 1) + ) + class(post_list) <- "postList" + + # Test summary.postList function + summary_tab <- summary.postList(post_list) + expect_is(summary_tab, "matrix") +})