R/sim_estimate_effect_variance.R

In psborrow2: Bayesian Dynamic Borrowing Analysis and Simulation

#' What is the variance of the log treatment effect
#'
#' @param draws draws_array Object of class `draws` from
#' `CmdStanMCMC$draws()`.
#'
#' @return the variance of the log OR or HR
#'
#' @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_effect_variance(draws)
sim_estimate_effect_variance <- function(draws) {
  effect_index <- dimnames(draws)$variable == "beta_trt"
  variance <- posterior::variance(draws[, , effect_index])
  return(variance)
}