- updated getContr()

R/BMCPMod.R

@@ -14,18 +14,25 @@ assessDesign <- function (
   mods,
   prior_list,
 
+  sd             = NULL,
+
   n_sim          = 1e3,
   alpha_crit_val = 0.05,
   simple         = TRUE
 
 ) {
 
   dose_levels <- attr(prior_list, "dose_levels")
+  sd          <- ifelse(is.null(sd), attr(prior_list, "sd_tot"), sd)
+
+  stopifnot(
+    "sd length must coincide with number of dose levels" =
+      length(sd) == length(dose_levels))
 
   data <- simulateData(
     n_patients  = n_patients,
     dose_levels = dose_levels,
-    sd          = attr(prior_list, "sd_tot"),
+    sd          = sd,
     mods        = mods,
     n_sim       = n_sim)
 
@@ -43,7 +50,7 @@ assessDesign <- function (
       dose_weights   = n_patients,
       alpha_crit_val = alpha_crit_val)
 
-    contr_mat_prior <- getContrMat(
+    contr_mat_prior <- getContr(
       mods           = mods,
       dose_levels    = dose_levels,
       dose_weights   = n_patients,
@@ -63,31 +70,75 @@ assessDesign <- function (
 
 }
 
-#' @title getContrMat
+#' @title getContr
 #' 
 #' @param mods tbd
 #' @param dose_levels tbd
 #' @param dose_weights tbd
 #' @param prior_list tbd
+#' @param se_new_trial tbd
+#' @param sd_posterior tbd
 #' 
 #' @export
-getContrMat <- function (
+getContr <- function (
 
   mods,
   dose_levels,
-  dose_weights,
-  prior_list
+  dose_weights = NULL,
+  prior_list   = NULL,
+  se_new_trial = NULL,
+  sd_posterior = NULL
 
 ) {
 
-  ess_prior <- suppressMessages(round(unlist(lapply(prior_list, RBesT::ess))))
+  if (is.null(prior_list)) { # frequentist
+
+    if (!is.null(se_new_trial)) { # re-estimate, se_new_trial
+
+      w <- NULL
+      S <- diag((se_new_trial)^2)
+
+    } else { # do not re-estimate, dose_weights
+
+      w <- dose_weights
+      S <- NULL
+
+    }
+
+  } else { # Bayes
+
+    if (!is.null(sd_posterior)) { # re-estimate, sd_posterior
+
+      w <- NULL
+      S <- diag((sd_posterior)^2)
+
+    } else { # do not re-estimate, dose_weights + prior_list
+
+      w <- dose_weights +
+        suppressMessages(round(unlist(lapply(prior_list, RBesT::ess))))
+      S <- NULL
+
+    }
+
+  }
 
-  contr_mat <- DoseFinding::optContr(
-    models = mods,
-    doses  = dose_levels,
-    w      = dose_weights + ess_prior)
+  if (is.null(w)) {
+
+    contr <- DoseFinding::optContr(
+      models = mods,
+      doses  = dose_levels,
+      S      = S)
+
+  } else {
+
+    contr <- DoseFinding::optContr(
+      models = mods,
+      doses  = dose_levels,
+      w      = w)
+
+  }
 
-  return (contr_mat)
+  return (contr)
 
 }
 
@@ -204,7 +255,7 @@ addSignificance <- function (
 
 }
 
-#' @title BayesianMCP
+#' @title performBayesianMCP
 #' 
 #' @param posteriors_list tbd
 #' @param contr_mat tbd
@@ -270,7 +321,8 @@ BayesMCPi <- function (
 
   res <- c(sign       = ifelse(max(post_probs) > crit_prob, 1, 0),
            p_val      = max(post_probs),
-           post_probs = post_probs)
+           post_probs = post_probs,
+           crit_prob  = crit_prob) # TODO  attr crit_prob??
 
   return (res)
 

R/s3methods.R

@@ -53,6 +53,12 @@ print.BayesianMCP <- function (
   cat("  Estimated Success Rate: ", power, "\n")
   cat("  N Simulations:          ", n_sim)
 
+  ## TODO if n_nim == 1
+  # c(sign       = ifelse(max(post_probs) > crit_prob, 1, 0),
+  #   p_val      = max(post_probs),
+  #   post_probs = post_probs,
+  #   crit_prob  = crit_prob)
+
 }
 
 ## ModelFits ----------------------------------------------

R/simulation.R

@@ -61,4 +61,4 @@ getModelData <- function (
 
   return (model_data)
 
-}
+}

vignettes/analysis_normal.Rmd

@@ -123,7 +123,7 @@ crit_pval <- getCritProb(
   dose_weights   = n_patients,
   alpha_crit_val = 0.1)
 
-contr_mat_prior <- getContrMat(
+contr_mat_prior <- getContr(
   mods           = mods,
   dose_levels    = dose_levels,
   dose_weights   = n_patients,