added tests

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")
+})

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")
+})

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")
+})