Merge pull request #23 from Boehringer-Ingelheim/update-testing

Update testing

tests/testthat/setup.R

@@ -1,5 +1,5 @@
 #' @title getPriorList
-#' 
+#'
 #' @param hist_data historical trial summary level data,
 #' needs to be provided as a dataframe. Including information of the
 #' estimates and variability.
@@ -11,22 +11,22 @@
 #' value for the weight of the robustification component
 #'
 getPriorList <- function (
-    
+
   hist_data,
   dose_levels,
   dose_names       = NULL,
   robust_weight
-  
+
 ) {
-  
+
   checkmate::check_data_frame(hist_data)
   checkmate::assert_double(dose_levels, lower = 0, any.missing = FALSE)
   checkmate::check_string(dose_names, null.ok = TRUE)
   checkmate::check_vector(dose_names, null.ok = TRUE, len = length(dose_levels))
   checkmate::check_numeric(robust_weight, len = 1, null.ok = FALSE)
-  
+
   sd_tot <- with(hist_data, sum(sd * n) / sum(n))
-  
+
   gmap <- RBesT::gMAP(
     formula    = cbind(est, se) ~ 1 | trial,
     weights    = hist_data$n,
@@ -35,56 +35,66 @@ getPriorList <- function (
     beta.prior = cbind(0, 100 * sd_tot),
     tau.dist   = "HalfNormal",
     tau.prior  = cbind(0, sd_tot / 4))
-  
+
   prior_ctr <- RBesT::automixfit(gmap)
-  
+
   prior_ctr <- suppressMessages(RBesT::robustify(
     priormix = prior_ctr,
     weight   = robust_weight,
     sigma    = sd_tot))
-  
-  
+
+
   prior_trt <- RBesT::mixnorm(
     comp1 = c(w = 1, m = summary(prior_ctr)[1], n = 1),
     sigma = sd_tot,
     param = "mn")
-  
+
   prior_list <- c(list(prior_ctr),
                   rep(x     = list(prior_trt),
                       times = length(dose_levels[-1])))
-  
+
   if (is.null(dose_names)) {
     dose_names <- c("Ctr", paste0("DG_", seq_along(dose_levels[-1])))
   }
-  
+
   names(prior_list) <- dose_names
-  
+
   return (prior_list)
-  
+
 }
 
 
+# read in testdata --------------------------------------------------------
+
+testdata <- readRDS("data/testdata.RDS")
+
+
+
+# further setup -----------------------------------------------------------
+
+
+
 getPostProb <- function (
-    
+
   contr_j,     # j: dose level
   post_combs_i # i: simulation outcome
-  
+
 ) {
-  
+
   ## Test statistic = sum over all components of
   ## posterior weight * normal probability distribution of
   ## critical values for doses * estimated mean / sqrt(product of critical values for doses)
-  
+
   ## Calculation for each component of the posterior
   contr_theta   <- apply(post_combs_i$means, 1, `%*%`, contr_j)
   contr_var     <- apply(post_combs_i$vars, 1, `%*%`, contr_j^2)
   contr_weights <- post_combs_i$weights
-  
+
   ## P(c_m * theta > 0 | Y = y) for a shape m (and dose j)
   post_probs <- sum(contr_weights * stats::pnorm(contr_theta / sqrt(contr_var)))
-  
+
   return (post_probs)
-  
+
 }
 
 # Create minimal test case
@@ -104,7 +114,7 @@ mean <- c(8, 12)
 sd <- c(0.5, 0.8)
 
 mods <- DoseFinding::Mods(
-  linear = NULL, 
+  linear = NULL,
   doses = dose_levels
 )
 
@@ -133,22 +143,22 @@ posterior_list <- getPosterior(
 )
 
 contr_mat = getContr(
-  mods = mods, 
-  dose_levels = dose_levels, 
+  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, 
+  mods = mods,
+  dose_levels = dose_levels,
+  dose_weights = n_patients,
   alpha_crit_val = alpha_crit_val
 )
 
 # eval_design <- assessDesign(
-#   n_patients = n_patients, 
-#   mods = mods, 
+#   n_patients = n_patients,
+#   mods = mods,
 #   prior_list = prior_list,
 #   n_sim = n_sim,
 #   alpha_crit_val = alpha_crit_val,
@@ -178,7 +188,7 @@ names(prior_list_matrix) <- c("Ctr","DG_1","DG_2","DG_3","DG_4")
 mu_hat <- c(10, 20, 30, 40, 50)
 se_hat_vector <- c(1.0, 3.0, 5.0, 9.0, 6.0)
 se_hat_vector_sqrt <- c(sqrt(1), sqrt(3), sqrt(5), sqrt(9), sqrt(6))
- 
+
 se_hat_matrix <- matrix(c(1.00, 0.00, 0.00, 0.00, 0.00,
                           0.00, 3.00, 0.00, 0.00, 0.00,
                           0.00, 0.00, 5.00, 0.00, 0.00,