R/sim_estimate_mse.R

In psborrow2: Bayesian Dynamic Borrowing Analysis and Simulation

#' What is the MSE for a given model
#'
#' @param draws draws_array Object of class `draws` from
#' `CmdStanMCMC$draws()`.
#' @param true_effect numeric. The true treatment effect.
#'
#' @return the mean squared error (MSE) of the sample
#'
#' @details
#' MSE will be calculated as (true_effect - median_estimated_effect) ^ 2
#'
#' @noRd
#' @examples
#' base_mat <- matrix(
#'   c(
#'     rep(0, 200), rep(0, 200), rep(1, 200),
#'     rep(1, 200), rep(0, 200), rep(0, 200),
#'     rep(0, 600)
#'   ),
#'   ncol = 3,
#'   dimnames = list(NULL, c("ext", "trt", "driftOR"))
#' )
#'
#' add_binary_endpoint <- function(odds_ratio,
#'                                 base_matrix = base_mat) {
#'   linear_predictor <- base_matrix[, "trt"] * log(odds_ratio)
#'   prob <- 1 / (1 + exp(-linear_predictor))
#'
#'   bin_endpoint <- rbinom(
#'     NROW(base_matrix),
#'     1,
#'     prob
#'   )
#'
#'   cbind(base_matrix, matrix(bin_endpoint, ncol = 1, dimnames = list(NULL, "ep")))
#' }
#'
#' data_list <- list(
#'   list(add_binary_endpoint(1.5), add_binary_endpoint(1.5)),
#'   list(add_binary_endpoint(2.5), add_binary_endpoint(2.5))
#' )
#'
#' guide <- data.frame(
#'   trueOR = c(1.5, 2.5),
#'   driftOR = c(1.0, 1.0),
#'   index = 1:2
#' )
#'
#' sdl <- sim_data_list(
#'   data_list = data_list,
#'   guide = guide,
#'   effect = "trueOR",
#'   drift = "driftOR",
#'   index = "index"
#' )
#'
#' x <- create_simulation_obj(
#'   data_matrix_list = sdl,
#'   outcome = outcome_bin_logistic("ep", prior_normal(0, 1000)),
#'   borrowing = sim_borrowing_list(list(
#'     full_borrowing = borrowing_full("ext"),
#'     bdb = borrowing_hierarchical_commensurate("ext", prior_exponential(0.0001))
#'   )),
#'   treatment = treatment_details("trt", prior_normal(0, 1000))
#' )
#'
#' i <- 1
#' j <- 1
#' true_effect <- x@guide[i, x@data_matrix_list@effect]
#' anls_obj <- x@analysis_obj_list[[i]][[j]]
#' res <- mcmc_sample(anls_obj, iter_sampling = 500)
#' draws <- res$draws()
#'
#' psborrow2:::sim_estimate_mse(
#'   draws,
#'   true_effect
#' )
sim_estimate_mse <- function(draws,
                             true_effect) {
  effect_index <- dimnames(draws)$variable %in% c("HR_trt", "OR_trt")
  mse <- mean((draws[, , effect_index] - true_effect)^2)
  return(mse)
}