## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width = 7, fig.height = 5.5, fig.path = "figures/2cont-" ) library(BayesianQDM) ## ----nine-region-cont, echo = FALSE, results = 'asis'------------------------- cat('
Nine-region grid for two-endpoint posterior probability
Endpoint 1
θ1 > θTV1 θTV1 ≥ θ1 > θMAV1 θMAV1 ≥ θ1
Endpoint 2 θ2 > θTV2 R1 R4 R7
θTV2 ≥ θ2 > θMAV2 R2 R5 R8
θMAV2 ≥ θ2 R3 R6 R9
') ## ----four-region-cont, echo = FALSE, results = 'asis'------------------------- cat('
Four-region grid for two-endpoint predictive probability
Endpoint 1
θ1 > θNULL1 θ1 ≤ θNULL1
Endpoint 2 θ2 > θNULL2 R1 R3
θ2 ≤ θNULL2 R2 R4
') ## ----ctrl-post-vague---------------------------------------------------------- S_t <- matrix(c(18.0, 3.6, 3.6, 9.0), 2, 2) S_c <- matrix(c(16.0, 2.8, 2.8, 8.5), 2, 2) set.seed(42) p_post_vague <- pbayespostpred2cont( prob = 'posterior', design = 'controlled', prior = 'vague', theta_TV1 = 1.5, theta_MAV1 = 0.5, theta_TV2 = 1.0, theta_MAV2 = 0.3, theta_NULL1 = NULL, theta_NULL2 = NULL, n_t = 20L, n_c = 20L, ybar_t = c(3.5, 2.1), S_t = S_t, ybar_c = c(1.8, 1.0), S_c = S_c, m_t = NULL, m_c = NULL, kappa0_t = NULL, nu0_t = NULL, mu0_t = NULL, Lambda0_t = NULL, kappa0_c = NULL, nu0_c = NULL, mu0_c = NULL, Lambda0_c = NULL, r = NULL, ne_t = NULL, ne_c = NULL, alpha0e_t = NULL, alpha0e_c = NULL, bar_ye_t = NULL, bar_ye_c = NULL, se_t = NULL, se_c = NULL, nMC = 5000L ) print(round(p_post_vague, 4)) cat(sprintf( "g_Go = P(R1 | data) = %.4f\n", p_post_vague["R1"] )) cat(sprintf( "g_NoGo = P(R9 | data) = %.4f\n\n", p_post_vague["R9"] )) cat(sprintf( "Go criterion: g_Go >= gamma1 (0.80)? %s\n", ifelse(p_post_vague["R1"] >= 0.80, "YES", "NO") )) cat(sprintf( "NoGo criterion: g_NoGo >= gamma2 (0.20)? %s\n", ifelse(p_post_vague["R9"] >= 0.20, "YES", "NO") )) cat(sprintf("Decision: %s\n", ifelse(p_post_vague["R1"] >= 0.80 & p_post_vague["R9"] < 0.20, "Go", ifelse(p_post_vague["R1"] < 0.80 & p_post_vague["R9"] >= 0.20, "NoGo", ifelse(p_post_vague["R1"] >= 0.80 & p_post_vague["R9"] >= 0.20, "Miss", "Gray"))) )) ## ----ctrl-post-niw------------------------------------------------------------ L0 <- matrix(c(8.0, 0.0, 0.0, 2.0), 2, 2) set.seed(42) p_post_niw <- pbayespostpred2cont( prob = 'posterior', design = 'controlled', prior = 'N-Inv-Wishart', theta_TV1 = 1.5, theta_MAV1 = 0.5, theta_TV2 = 1.0, theta_MAV2 = 0.3, theta_NULL1 = NULL, theta_NULL2 = NULL, n_t = 20L, n_c = 20L, ybar_t = c(3.5, 2.1), S_t = S_t, ybar_c = c(1.8, 1.0), S_c = S_c, m_t = NULL, m_c = NULL, kappa0_t = 2.0, nu0_t = 5.0, mu0_t = c(2.0, 1.0), Lambda0_t = L0, kappa0_c = 2.0, nu0_c = 5.0, mu0_c = c(0.0, 0.0), Lambda0_c = L0, r = NULL, ne_t = NULL, ne_c = NULL, alpha0e_t = NULL, alpha0e_c = NULL, bar_ye_t = NULL, bar_ye_c = NULL, se_t = NULL, se_c = NULL, nMC = 5000L ) print(round(p_post_niw, 4)) ## ----ctrl-pred---------------------------------------------------------------- set.seed(42) p_pred <- pbayespostpred2cont( prob = 'predictive', design = 'controlled', prior = 'vague', theta_TV1 = NULL, theta_MAV1 = NULL, theta_TV2 = NULL, theta_MAV2 = NULL, theta_NULL1 = 0.5, theta_NULL2 = 0.3, n_t = 20L, n_c = 20L, ybar_t = c(3.5, 2.1), S_t = S_t, ybar_c = c(1.8, 1.0), S_c = S_c, m_t = 60L, m_c = 60L, kappa0_t = NULL, nu0_t = NULL, mu0_t = NULL, Lambda0_t = NULL, kappa0_c = NULL, nu0_c = NULL, mu0_c = NULL, Lambda0_c = NULL, r = NULL, ne_t = NULL, ne_c = NULL, alpha0e_t = NULL, alpha0e_c = NULL, bar_ye_t = NULL, bar_ye_c = NULL, se_t = NULL, se_c = NULL, nMC = 5000L ) print(round(p_pred, 4)) cat(sprintf( "\nGo region (R1): P = %.4f >= gamma1 (0.80)? %s\n", p_pred["R1"], ifelse(p_pred["R1"] >= 0.80, "YES", "NO") )) cat(sprintf( "NoGo region (R4): P = %.4f >= gamma2 (0.20)? %s\n", p_pred["R4"], ifelse(p_pred["R4"] >= 0.20, "YES", "NO") )) cat(sprintf("Decision: %s\n", ifelse(p_pred["R1"] >= 0.80 & p_pred["R4"] < 0.20, "Go", ifelse(p_pred["R1"] < 0.80 & p_pred["R4"] >= 0.20, "NoGo", ifelse(p_pred["R1"] >= 0.80 & p_pred["R4"] >= 0.20, "Miss", "Gray"))) )) ## ----unctrl-post-------------------------------------------------------------- set.seed(1) p_unctrl <- pbayespostpred2cont( prob = 'posterior', design = 'uncontrolled', prior = 'N-Inv-Wishart', theta_TV1 = 1.5, theta_MAV1 = 0.5, theta_TV2 = 1.0, theta_MAV2 = 0.3, theta_NULL1 = NULL, theta_NULL2 = NULL, n_t = 20L, n_c = NULL, ybar_t = c(3.5, 2.1), S_t = S_t, ybar_c = NULL, S_c = NULL, m_t = NULL, m_c = NULL, kappa0_t = 2.0, nu0_t = 5.0, mu0_t = c(2.0, 1.0), Lambda0_t = L0, kappa0_c = NULL, nu0_c = NULL, mu0_c = c(0.0, 0.0), Lambda0_c = NULL, r = 1.0, ne_t = NULL, ne_c = NULL, alpha0e_t = NULL, alpha0e_c = NULL, bar_ye_t = NULL, bar_ye_c = NULL, se_t = NULL, se_c = NULL, nMC = 5000L ) print(round(p_unctrl, 4)) ## ----ext-post-vague----------------------------------------------------------- S_t <- matrix(c(18.0, 3.6, 3.6, 9.0), 2, 2) S_c <- matrix(c(16.0, 2.8, 2.8, 8.5), 2, 2) Se2_ext <- matrix(c(15.0, 2.5, 2.5, 7.5), 2, 2) set.seed(2) p_ext_vague <- pbayespostpred2cont( prob = 'posterior', design = 'external', prior = 'vague', theta_TV1 = 1.5, theta_MAV1 = 0.5, theta_TV2 = 1.0, theta_MAV2 = 0.3, theta_NULL1 = NULL, theta_NULL2 = NULL, n_t = 20L, n_c = 20L, ybar_t = c(3.5, 2.1), S_t = S_t, ybar_c = c(1.8, 1.0), S_c = S_c, m_t = NULL, m_c = NULL, kappa0_t = NULL, nu0_t = NULL, mu0_t = NULL, Lambda0_t = NULL, kappa0_c = NULL, nu0_c = NULL, mu0_c = NULL, Lambda0_c = NULL, r = NULL, ne_t = NULL, ne_c = 10L, alpha0e_t = NULL, alpha0e_c = 0.5, bar_ye_t = NULL, bar_ye_c = c(1.5, 0.8), se_t = NULL, se_c = Se2_ext, nMC = 5000L ) print(round(p_ext_vague, 4)) ## ----ext-post----------------------------------------------------------------- S_t <- matrix(c(18.0, 3.6, 3.6, 9.0), 2, 2) S_c <- matrix(c(16.0, 2.8, 2.8, 8.5), 2, 2) L0 <- matrix(c(8.0, 0.0, 0.0, 2.0), 2, 2) Se2_ext <- matrix(c(15.0, 2.5, 2.5, 7.5), 2, 2) set.seed(3) p_ext <- pbayespostpred2cont( prob = 'posterior', design = 'external', prior = 'N-Inv-Wishart', theta_TV1 = 1.5, theta_MAV1 = 0.5, theta_TV2 = 1.0, theta_MAV2 = 0.3, theta_NULL1 = NULL, theta_NULL2 = NULL, n_t = 20L, n_c = 20L, ybar_t = c(3.5, 2.1), S_t = S_t, ybar_c = c(1.8, 1.0), S_c = S_c, m_t = NULL, m_c = NULL, kappa0_t = 2.0, nu0_t = 5.0, mu0_t = c(2.0, 1.0), Lambda0_t = L0, kappa0_c = 2.0, nu0_c = 5.0, mu0_c = c(0.0, 0.0), Lambda0_c = L0, r = NULL, ne_t = NULL, ne_c = 10L, alpha0e_t = NULL, alpha0e_c = 0.5, bar_ye_t = NULL, bar_ye_c = c(1.5, 0.8), se_t = NULL, se_c = Se2_ext, nMC = 5000L ) print(round(p_ext, 4)) ## ----oc-controlled, fig.width = 8, fig.height = 6----------------------------- Sigma <- matrix(c(4.0, 0.8, 0.8, 1.0), 2, 2) mu_t1_seq <- seq(0.0, 3.5, by = 0.5) mu_t2_seq <- seq(0.0, 2.1, by = 0.3) n_scen <- length(mu_t1_seq) * length(mu_t2_seq) oc_ctrl <- pbayesdecisionprob2cont( nsim = 100L, prob = 'posterior', design = 'controlled', prior = 'vague', GoRegions = 1L, NoGoRegions = 9L, gamma_go = 0.80, gamma_nogo = 0.20, theta_TV1 = 1.5, theta_MAV1 = 0.5, theta_TV2 = 1.0, theta_MAV2 = 0.3, theta_NULL1 = NULL, theta_NULL2 = NULL, n_t = 20L, n_c = 20L, m_t = NULL, m_c = NULL, mu_t = cbind(rep(mu_t1_seq, times = length(mu_t2_seq)), rep(mu_t2_seq, each = length(mu_t1_seq))), Sigma_t = Sigma, mu_c = matrix(0, nrow = n_scen, ncol = 2), Sigma_c = Sigma, kappa0_t = NULL, nu0_t = NULL, mu0_t = NULL, Lambda0_t = NULL, kappa0_c = NULL, nu0_c = NULL, mu0_c = NULL, Lambda0_c = NULL, r = NULL, ne_t = NULL, ne_c = NULL, alpha0e_t = NULL, alpha0e_c = NULL, bar_ye_t = NULL, bar_ye_c = NULL, se_t = NULL, se_c = NULL, nMC = 500L, CalcMethod = 'MC', error_if_Miss = TRUE, Gray_inc_Miss = FALSE, seed = 42L ) print(oc_ctrl) plot(oc_ctrl, base_size = 20) ## ----getgamma-ctrl, fig.width = 8, fig.height = 6----------------------------- res_gamma <- getgamma2cont( nsim = 500L, prob = 'posterior', design = 'controlled', prior = 'vague', GoRegions = 1L, NoGoRegions = 9L, mu_t_go = c(0.5, 0.3), Sigma_t_go = Sigma, mu_c_go = c(0.0, 0.0), Sigma_c_go = Sigma, mu_t_nogo = c(1.0, 0.6), Sigma_t_nogo = Sigma, mu_c_nogo = c(0.0, 0.0), Sigma_c_nogo = Sigma, target_go = 0.05, target_nogo = 0.20, n_t = 20L, n_c = 20L, theta_TV1 = 1.5, theta_MAV1 = 0.5, theta_TV2 = 1.0, theta_MAV2 = 0.3, theta_NULL1 = NULL, theta_NULL2 = NULL, m_t = NULL, m_c = NULL, kappa0_t = NULL, nu0_t = NULL, mu0_t = NULL, Lambda0_t = NULL, kappa0_c = NULL, nu0_c = NULL, mu0_c = NULL, Lambda0_c = NULL, r = NULL, ne_t = NULL, ne_c = NULL, alpha0e_t = NULL, alpha0e_c = NULL, bar_ye_t = NULL, bar_ye_c = NULL, se_t = NULL, se_c = NULL, nMC = 500L, CalcMethod = 'MC', gamma_go_grid = seq(0.05, 0.95, by = 0.05), gamma_nogo_grid = seq(0.05, 0.95, by = 0.05), seed = 42L ) plot(res_gamma, base_size = 20)