What is the bias for a given model

Usage

sim_estimate_bias(draws, true_effect)

Arguments

draws: draws_array Object of class draws from CmdStanMCMC$draws().
true_effect: numeric. The true treatment effect.

Value

the bias of the sample

Details

Bias will be calculated as (true_effect - median_estimated_effect)

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 = logistic_bin_outcome("ep", normal_prior(0, 1000)),
  borrowing = sim_borrowing_list(list(
    full_borrowing = borrowing_details("Full borrowing", "ext"),
    bdb = borrowing_details("BDB", "ext", exponential_prior(0.0001))
  )),
  treatment = treatment_details("trt", normal_prior(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)
#> Running MCMC with 4 sequential chains...
#> 
#> Chain 1 finished in 0.6 seconds.
#> Chain 2 finished in 0.6 seconds.
#> Chain 3 finished in 0.6 seconds.
#> Chain 4 finished in 0.6 seconds.
#> 
#> All 4 chains finished successfully.
#> Mean chain execution time: 0.6 seconds.
#> Total execution time: 2.7 seconds.
#> 
draws <- res$draws()

psborrow2:::sim_estimate_bias(
  draws,
  true_effect
)
#> [1] 0.1086686