set.seed(2026)
n_ipd2 <- 200
n_agd2 <- 150
1rho_true <- -0.30
# Gaussian copula: correlate on the normal scale, then swap in the marginals
gen_pair <- function(n, rho, age_m, age_s, wbc_m, wbc_s) {
2 L <- t(chol(matrix(c(1, rho, rho, 1), 2, 2)))
3 z <- L %*% matrix(rnorm(2 * n), nrow = 2)
4 u <- pnorm(z)
data.frame(
age = qnorm(u[1, ], mean = age_m, sd = age_s),
wbc = qgamma(u[2, ], shape = wbc_m^2 / wbc_s^2, rate = wbc_m / wbc_s^2)
)
}
# Shared individual-level model for both trials
lp <- function(age, wbc, active, eff) {
-0.8 + eff * active - 0.04 * (age - 55) - 0.02 * (wbc - 40)
}
# --- Trial 1: IPD, two correlated covariates ---
ipd_2d <- gen_pair(n_ipd2, rho_true, age_m = 55, age_s = 10,
wbc_m = 40, wbc_s = 20) |>
mutate(
study = "Trial_1",
trt = sample(c("Placebo", "Quizartinib"), n_ipd2, replace = TRUE),
class = if_else(trt == "Placebo", "Placebo", "Active"),
outcome = rbinom(n_ipd2, 1, plogis(lp(age, wbc, trt == "Quizartinib", 1.3)))
)
# Borrow correlation from IPD — the only joint-distribution information available
5rho <- cor(ipd_2d$age, ipd_2d$wbc)
# --- Trial 2: AgD, simulated from the SAME model, then collapsed to summaries ---
agd_pbo <- gen_pair(n_agd2, rho_true, 70, 5, 50, 15)
agd_mido <- gen_pair(n_agd2, rho_true, 70, 5, 50, 15)
r_pbo <- sum(rbinom(n_agd2, 1, plogis(lp(agd_pbo$age, agd_pbo$wbc, 0, 1.1))))
r_mido <- sum(rbinom(n_agd2, 1, plogis(lp(agd_mido$age, agd_mido$wbc, 1, 1.1))))
6agd_pool <- rbind(agd_pbo, agd_mido)
agd_2d <- data.frame(
study = "Trial_2",
trt = c("Placebo", "Midostaurin"),
class = c("Placebo", "Active"),
r = c(r_pbo, r_mido),
n = c(n_agd2, n_agd2),
age_mean = mean(agd_pool$age), age_sd = sd(agd_pool$age),
wbc_mean = mean(agd_pool$wbc), wbc_sd = sd(agd_pool$wbc)
) |>
mutate(wbc_shape = wbc_mean^2 / wbc_sd^2,
wbc_rate = wbc_mean / wbc_sd^2)
net_2d <- combine_network(
set_ipd(ipd_2d, study = study, trt = trt, r = outcome, trt_class = class),
set_agd_arm(agd_2d, study = study, trt = trt, r = r, n = n, trt_class = class),
trt_ref = "Placebo"
)
# Add 2D Sobol integration with Cholesky-based correlation
net_2d <- add_integration(net_2d,
age = distr(qnorm, mean = age_mean, sd = age_sd),
wbc = distr(qgamma, shape = wbc_shape, rate = wbc_rate),
cor = matrix(c(1, rho, rho, 1), 2, 2), # Cholesky applied internally
n_int = 64
)
cat(sprintf("Age-WBC correlation borrowed from IPD: rho = %+.3f (data-generating %+.2f)\n",
rho, rho_true))
cat(sprintf("IPD CR rates: Placebo %.1f%% | Quizartinib %.1f%%\n",
100 * mean(ipd_2d$outcome[ipd_2d$trt == "Placebo"]),
100 * mean(ipd_2d$outcome[ipd_2d$trt == "Quizartinib"])))
cat(sprintf("AgD CR rates: Placebo %.1f%% (%d/%d) | Midostaurin %.1f%% (%d/%d)\n",
100 * r_pbo / n_agd2, r_pbo, n_agd2,
100 * r_mido / n_agd2, r_mido, n_agd2))
cat("2D Sobol integration configured: 64 nodes per AgD arm | covariates age + WBC\n")