R/true_vals_exp_nocovar.R

In BPrinStratTTE: Causal Effects in Principal Strata Defined by Antidrug Antibodies

#' Adding true values to estimates for models with an exponential endpoint and no consideration of predictors of the intercurrent event
#'
#' @param x Model object as returned by `fit_single_exp_nocovar()`.
#' @param d_params List of data parameters as used in `fit_single_exp_nocovar()`.
#' @param m_params List of model parameters as used in `fit_single_exp_nocovar()`.
#'
#' @return A summary table with parameter estimates, true values and differences.
#' @export
#' 
#' @seealso [true_vals_exp_covar()]
#' 
#' @examples
#' d_params_nocovar <- list(
#'   n = 500L,
#'   nt = 250L,
#'   prob_ice = 0.5,
#'   fu_max = 336L,
#'   T0T_rate = 0.2,
#'   T0N_rate = 0.2,
#'   T1T_rate = 0.15,
#'   T1N_rate = 0.1
#' )
#' dat_single_trial <- sim_dat_one_trial_exp_nocovar(
#'   n = d_params_nocovar[["n"]], 
#'   nt = d_params_nocovar[["nt"]],
#'   prob_ice = d_params_nocovar[["prob_ice"]],
#'   fu_max = d_params_nocovar[["fu_max"]],  
#'   T0T_rate = d_params_nocovar[["T0T_rate"]],
#'   T0N_rate = d_params_nocovar[["T0N_rate"]],
#'   T1T_rate = d_params_nocovar[["T1T_rate"]],
#'   T1N_rate = d_params_nocovar[["T1N_rate"]] 
#' )
#' m_params_nocovar <- list(
#'   tg = 48L,
#'   prior_piT = c(0.5, 0.5),
#'   prior_0N = c(1.5, 5),
#'   prior_1N = c(1.5, 5),
#'   prior_0T = c(1.5, 5),
#'   prior_1T = c(1.5, 5),
#'   t_grid =  seq(7, 7 * 48, 7) / 30,
#'   chains = 2L,
#'   n_iter = 3000L,
#'   warmup = 1500L,
#'   cores = 2L,
#'   open_progress = FALSE,
#'   show_messages = TRUE  
#' )
#' \donttest{
#' fit_single <- fit_single_exp_nocovar(
#'   data = dat_single_trial,
#'   params = m_params_nocovar,
#'   summarize_fit = TRUE 
#' )
#' print(fit_single) 
#' tab_obs_truth <- true_vals_exp_nocovar(
#'   x = fit_single,
#'   d_params = d_params_nocovar,
#'   m_params = m_params_nocovar
#' )
#' print(tab_obs_truth)
#' }
true_vals_exp_nocovar <- function(x, d_params, m_params) {
  # use model summary
  patterns <- c("S_", "lp", "n_eff")
  y <- tibble::as_tibble(x) %>% 
    dplyr::filter(!grepl(paste(patterns, collapse="|"), var))
  # add new variables
  y <- y %>% dplyr::mutate(
    true_val = NA, diff_mean = NA, diff_median = NA, 
    coverage = NA, int_excl1 = NA, int_excl0 = NA,
    rhat_check = NA) 
  # add true proportion of patients with ICE
  y <- y %>% dplyr::mutate(
    true_val = ifelse(var=="pi_T", d_params[["prob_ice"]], true_val),
  )
  # add true hazard rate and hazard ratios
  y <- y %>% dplyr::mutate(
    true_val = ifelse(var=="lambda_0N", d_params[["T0N_rate"]], true_val),
    true_val = ifelse(var=="lambda_1N", d_params[["T1N_rate"]], true_val),
    true_val = ifelse(var=="lambda_0T", d_params[["T0T_rate"]], true_val),
    true_val = ifelse(var=="lambda_1T", d_params[["T1T_rate"]], true_val),
    true_val = ifelse(var=="hr_N", d_params[["T1N_rate"]]/d_params[["T0N_rate"]], 
                      true_val),
    true_val = ifelse(var=="hr_T", d_params[["T1T_rate"]]/d_params[["T0T_rate"]], 
                      true_val)
  )
  # add RMSTs and differences in RMSTs
  t_grid <- m_params[["t_grid"]]
  S_0n <- 1-pexp(t_grid, d_params[["T0N_rate"]])
  S_1n <- 1-pexp(t_grid, d_params[["T1N_rate"]])
  S_0c <- 1-pexp(t_grid, d_params[["T0T_rate"]])
  S_1c <- 1-pexp(t_grid, d_params[["T1T_rate"]])
  rmst_0n <- rmst_1n <- rmst_0c <- rmst_1c <- 0
  for (j in 2:length(t_grid)) {
    rmst_0n <- rmst_0n + ((S_0n[j-1]+S_0n[j])/2*(t_grid[j]-t_grid[j-1]))
    rmst_1n <- rmst_1n + ((S_1n[j-1]+S_1n[j])/2*(t_grid[j]-t_grid[j-1]))
    rmst_0c <- rmst_0c + ((S_0c[j-1]+S_0c[j])/2*(t_grid[j]-t_grid[j-1]))
    rmst_1c <- rmst_1c + ((S_1c[j-1]+S_1c[j])/2*(t_grid[j]-t_grid[j-1]))
  }
  d_rmst_n <- rmst_1n - rmst_0n
  d_rmst_c <- rmst_1c - rmst_0c
  y <- y %>% dplyr::mutate(
    true_val = ifelse(var=="rmst_N", d_rmst_n, true_val),
    true_val = ifelse(var=="rmst_T", d_rmst_c, true_val),
    true_val = ifelse(var=="rmst_0N", rmst_0n, true_val),
    true_val = ifelse(var=="rmst_1N", rmst_1n, true_val),
    true_val = ifelse(var=="rmst_0T", rmst_0c, true_val),
    true_val = ifelse(var=="rmst_1T", rmst_1c, true_val)
  )
  # add comparisons to true values and checks
  y <- y %>% dplyr::mutate(
    diff_mean = mean - true_val,
    diff_median = `50%` - true_val,
    coverage = ifelse(true_val >=`2.5%` & true_val <= `97.5%`, 1, 0),
    int_excl1= ifelse(1 <=`2.5%` | 1 >= `97.5%`, 1, 0),
    int_excl0= ifelse(0 <=`2.5%` | 0 >= `97.5%`, 1, 0),
    rhat_check = ifelse(Rhat >=0.98 & Rhat <= 1.02, 1, 0),
  )
  # return summary table
  return(y)
}