Unit tests

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BayesianMCPMod
 Title: Bayesian MCPMod
-Version: 0.1.3-3
+Version: 0.1.4-2
 Authors@R: c(
     person("Boehringer Ingelheim Pharma GmbH & Co. KG",
            role = c("cph", "fnd")),
@@ -11,7 +11,7 @@ Authors@R: c(
            role = "aut",
            email = "[email protected]"),
     person("Steven", "Brooks",
-           role = "aut",
+           role = "ctb",
            email = "[email protected]"),
     person("Sebastian", "Bossert",
            role = "aut",
@@ -32,7 +32,8 @@ Imports:
     clinDR,
     knitr,
     rmarkdown,
-    dplyr
+    dplyr,
+    checkmate
 Suggests:
     testthat (>= 3.0.0)
 Depends:

R/BMCPMod.R

@@ -1,17 +1,17 @@
 #' @title assessDesign
 #'.
 #' @description This function performs simulation based trial design evaluations for a set of specified dose-response models
 #'
 #' @param n_patients Vector specifying the planned number of patients per dose group
 #' @param mods An object of class "Mods" as specified in the DoseFinding package.
 #' @param prior_list a prior_list object specifying the utilized prior for the different dose groups 
 #' @param sd a positive value, specification of assumed sd 
 #' @param n_sim number of simulations to be performed
 #' @param alpha_crit_val (unadjusted) critical value to be used for the MCT testing step. Passed to the getCritProb function for the calculation of adjusted critical values (on the probability scale). Default is 0.05.
 #' @param simple boolean variable, defining whether simplified fit will be applied. Passed to the getModelFits function. Default FALSE.
 #' @param reestimate boolean variable, defining whether critical value should be calculated with re-estimated contrasts (see getCritProb function for more details). Default FALSE
 #' @param contr Allows specification of a fixed contrasts matrix. Default NULL
 #' @param dr_means a vector, allows specification of  individual (not model based) assumed effects per dose group. Default NULL
 #' 
 #' @return returns success probabilities for the different assumed dose-response shapes, attributes also includes information around average success rate (across all assumed models) and prior Effective sample size
 #' 
@@ -24,7 +24,6 @@
 #'                    DG_2 = RBesT::mixnorm(comp1 = c(w = 1, m = 1.2, s = 11), sigma = 2) ,  
 #'                    DG_3 = RBesT::mixnorm(comp1 = c(w = 1, m = 1.3, s = 11), sigma = 2) ,
 #'                    DG_4 = RBesT::mixnorm(comp1 = c(w = 1, m = 2, s = 13) ,sigma = 2))
-#' 
 #' n_patients <- c(40,60,60,60,60)
 #' success_probabilities <- assessDesign(
 #' n_patients  = n_patients,
@@ -53,6 +52,15 @@
 
 ) {
 
+  checkmate::assert_vector(n_patients, len = length(attr(mods, "doses")), any.missing = FALSE)
+  checkmate::check_class(mods, classes = "Mods")
+  checkmate::check_list(prior_list, names = "named", len = length(attr(mods, "doses")), any.missing = FALSE)
+  # sensitive to how DoseFinding labels their attributes for "Mods" class
+  checkmate::check_double(n_sim, lower = 1, upper = Inf)
+  checkmate::check_double(alpha_crit_val, lower = 0, upper = 1)
+  checkmate::check_logical(simple)
+  # TODO: check that prior_list has 'sd_tot' attribute, and that it's numeric
+
   dose_levels <- attr(mods, "doses")
 
   data <- simulateData(
@@ -172,6 +180,11 @@
 
 ) {
 
+  checkmate::check_class(mods, classes = "Mods")
+  checkmate::check_double(dose_levels, lower = 0, any.missing = FALSE, len = length(attr(mods, "doses")))
+  checkmate::check_double(dose_weights, any.missing = FALSE, len = length(attr(mods, "doses")))
+  checkmate::check_list(prior_list, names = "named", len = length(attr(mods, "doses")), any.missing = FALSE)
+
   # frequentist & re-estimation
   if (!is.null(se_new_trial) & 
       is.null(dose_weights) & is.null(prior_list) & is.null(sd_posterior)) {
@@ -267,6 +280,11 @@
 
 ) {
 
+  checkmate::check_class(mods, classes = "Mods")
+  checkmate::check_double(dose_levels, lower = 0, any.missing = FALSE, len = length(dose_weights))
+  checkmate::check_double(dose_weights, any.missing = FALSE, len = length(dose_levels))
+  checkmate::check_double(alpha_crit_val, lower = 0, upper = 1)
+
   contr <- getContr(mods           = mods,
                     dose_levels    = dose_levels ,
                     dose_weights   = dose_weights,
@@ -329,6 +347,17 @@
 
 ) {
 
+  checkmate::check_class(posterior_list, "postList")
+  checkmate::check_class(contr, "optContr")
+  checkmate::check_class(crit_prob_adj, "numeric")
+  checkmate::check_logical(simple)
+
+  if (inherits(posterior_list,  "postList")) {
+
+    posterior_list <- list(posterior_list)
+
+  }
+
   if (inherits(posterior_list,  "postList")) {
 
     posterior_list <- list(posterior_list)
@@ -453,6 +482,12 @@
   crit_prob_adj
 
 ) {
+
+  checkmate::check_class(posterior_list, "postList")
+  checkmate::check_class(contr, "optContr")
+  checkmate::check_class(crit_prob_adj, "numeric")
+  checkmate::check_numeric(crit_prob_adj, lower = 0, upper = Inf)
+
   if (inherits(posterior_list,  "postList")) {
 
     posterior_list <- list(posterior_list)

R/modelling.R

@@ -45,6 +45,10 @@ getModelFits <- function (
 
 ) {
 
+  checkmate::check_list(models, any.missing = FALSE)
+  checkmate::check_double(dose_levels, lower = 0, any.missing = FALSE, len = length(models))
+  checkmate::check_class(posterior, "postList")
+  checkmate::check_logical(simple)
   models      <- unique(gsub("\\d", "", models))
 
   getModelFit <- ifelse(simple, getModelFitSimple, getModelFitOpt)
@@ -137,7 +141,7 @@ getModelFitOpt <- function (
               ub     <- c(Inf, Inf, 1.5 * max(dose_levels), 0.5 * max(dose_levels))
               expr_i <- quote(sum((post_combs$means[i, ] - (theta[1] + theta[2] / (1 + exp((theta[3] - dose_levels) / theta[4]))))^2 / (post_combs$vars[i, ])))},
             {
-              stop (GENERAL$ERROR$MODEL_OPTIONS)})
+              stop ("error")})
 
     simple_fit <- getModelFitSimple(
       model       = model,
@@ -247,7 +251,7 @@ predictModelFit <- function (
       model_fit$coeffs["eMax"],
       model_fit$coeffs["ed50"],
       model_fit$coeffs["delta"])},
-    {stop(GENERAL$ERROR$MODEL_OPTIONS)})
+    {stop("error")})
 
   return (pred_vals)
 

R/plot.R

@@ -43,6 +43,15 @@ plot.modelFits <- function (
   ...
 
 ) {
+  checkmate::check_class(x, "modelFits")
+  checkmate::check_logical(gAIC)
+  checkmate::check_logical(avg_fit)
+  checkmate::check_logical(cr_intv)
+  checkmate::check_double(alpha_CrI, lower = 0, upper = 1)
+  checkmate::check_logical(cr_bands)
+  checkmate::check_double(alpha_CrB, lower = 0, upper = 1, len = 2)
+  checkmate::check_integer(n_bs_smpl, lower = 1, upper = Inf)
+  checkmate::check_string(acc_color, na.ok = TRUE)
 
   plot_res   <- 1e2
   model_fits <- x

R/posterior.R

@@ -1,4 +1,3 @@
-
 #' @title getPosterior
 #' 
 #' @description Either the patient level data or both mu_hat as well as sd_hat must to be provided. If patient level data is provided mu_hat and se_hat are calculated within the function using a linear model.
@@ -36,24 +35,23 @@ getPosterior <- function(
   calc_ess = FALSE
 
 ) {
-
-  if (!is.null(mu_hat) && !is.null(se_hat) && is.null(data)) {
-
-    posterior_list <- getPosteriorI(
-      prior_list = prior_list,
-      mu_hat     = mu_hat,
-      se_hat     = se_hat,
-      calc_ess   = calc_ess)
-
-  } else if (is.null(mu_hat) && is.null(se_hat) && !is.null(data)) {
-
-    posterior_list <- lapply(split(data, data$simulation), getPosteriorI,
-                             prior_list = prior_list, calc_ess = calc_ess)
-
+  checkmate::check_data_frame(data, null.ok = TRUE)
+  checkmate::check_list(prior_list, names = "named", any.missing = FALSE)
+  checkmate::check_vector(mu_hat, any.missing = FALSE, null.ok = TRUE)
+  checkmate::check_double(mu_hat, null.ok = TRUE, lower = -Inf, upper = Inf)
+  checkmate::check_vector(se_hat, any.missing = FALSE, null.ok = TRUE)
+  checkmate::check_double(se_hat, null.ok = TRUE, lower = 0, upper = Inf)
+
+  if (is.null(data)) {
+    posterior_list <- getPosteriorI(data_i = NULL, prior_list = prior_list,
+                                   mu_hat     = mu_hat,
+                                   se_hat     = se_hat)
   } else {
-
-    stop ("Either 'data' or 'mu_hat' and 'se_hat' must not be NULL.")
-
+  posterior_list <- lapply(split(data, data$simulation), getPosteriorI,
+                           prior_list = prior_list,
+                           mu_hat     = mu_hat,
+                           se_hat     = se_hat)
+
   }
 
   if (length(posterior_list) == 1) {
@@ -75,9 +73,21 @@ getPosteriorI <- function(
   calc_ess = FALSE
 
 ) {
+
+  checkmate::check_data_frame(data_i, null.ok = TRUE)
+  checkmate::check_list(prior_list, names = "named", any.missing = FALSE)
+  checkmate::check_vector(mu_hat, any.missing = FALSE, null.ok = TRUE)
+  checkmate::check_double(mu_hat, null.ok = TRUE, lower = -Inf, upper = Inf)
+  checkmate::check_vector(se_hat, any.missing = FALSE, null.ok = TRUE)
+  checkmate::check_double(se_hat, null.ok = TRUE, lower = 0, upper = Inf)
 
   if (is.null(mu_hat) && is.null(se_hat)) {
-
+    checkmate::check_data_frame(data_i, null.ok = FALSE)
+    # checkmate::assert_names(names(data_i), must.include = "reponse")
+    # needs fixing! the reponse field is not available after using simulateData
+    # posterior <- getPosterior(data = simulateData(4, dose_levels, new_trial$sd, mods), prior = prior_list,
+    #                           mu_hat = NULL,
+    #                           sd_hat = NULL)
     anova_res <- stats::lm(data_i$response ~ factor(data_i$dose) - 1)
     mu_hat    <- summary(anova_res)$coefficients[, 1]
     se_hat    <- summary(anova_res)$coefficients[, 2]
@@ -92,7 +102,6 @@ getPosteriorI <- function(
   } else {
 
     stop ("Both mu_hat and se_hat must be provided.")
-
   }
 
   post_list <- mapply(RBesT::postmix, prior_list, m = mu_hat, se = se_hat,

R/simulation.R

@@ -48,6 +48,13 @@ simulateData <- function(
 
 ) {
 
+  checkmate::check_vector(n_patients, any.missing = FALSE, len = length(dose_levels))
+  checkmate::check_double(dose_levels, lower = 0, any.missing = FALSE, len = length(n_patients))
+  checkmate::check_double(sd, len = 1, null.ok = FALSE, lower = 0, upper = Inf)
+  checkmate::check_class(mods, classes = "Mods")
+  checkmate::check_numeric(n_sim, lower = 0, upper = Inf, len = 1)
+  checkmate::check_string(true_model, null.ok = TRUE)
+
   if (!is.null(true_model)) {
 
     n_sim            <- 1
@@ -106,7 +113,7 @@ getModelData <- function (
 
 ) {
 
-  model_data              <- sim_data[, c("simulation", "dose", model_name)]
+  model_data <- sim_data[, c("simulation", "dose", model_name)]
   colnames(model_data)[3] <- "response"
 
   return (model_data)