set.seed(1234) n <- 80000 nreps <- 10 # cont Y just for testing that function runs df_sel$Y_cont <- plogis(df_sel$Y) + rnorm(nrow(df_sel), mean = 0, sd = 0.1) s_model <- glm(S ~ X + Y, family = binomial(link = "logit"), data = df_sel_source ) # 0 confounders nobias_model <- glm( Y ~ X, family = binomial(link = "logit"), data = df_sel_source ) df_observed <- data_observed( df_sel, exposure = "X", outcome = "Y_cont", confounders = NULL ) single_run <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est <- vector() for (i in 1:nreps) { bdf <- df_sel[sample(seq_len(n), n, replace = TRUE), ] df_observed <- data_observed( bdf, exposure = "X", outcome = "Y", confounders = NULL ) results <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est[i] <- results$estimate } or_true <- exp(summary(nobias_model)$coef[2, 1]) or_adjusted <- median(est) test_that("odds ratio and confidence interval output", { expect_gt(or_adjusted, or_true - 0.1) expect_lt(or_adjusted, or_true + 0.1) expect_vector( single_run$ci, ptype = double(), size = 2 ) }) # 1 confounder nobias_model <- glm(Y ~ X + C1, family = binomial(link = "logit"), data = df_sel_source ) df_observed <- data_observed( df_sel, exposure = "X", outcome = "Y_cont", confounders = "C1" ) single_run <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est <- vector() for (i in 1:nreps) { bdf <- df_sel[sample(seq_len(n), n, replace = TRUE), ] df_observed <- data_observed( bdf, exposure = "X", outcome = "Y", confounders = "C1" ) results <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est[i] <- results$estimate } or_true <- exp(summary(nobias_model)$coef[2, 1]) or_adjusted <- median(est) test_that("odds ratio and confidence interval output", { expect_gt(or_adjusted, or_true - 0.1) expect_lt(or_adjusted, or_true + 0.1) expect_vector( single_run$ci, ptype = double(), size = 2 ) }) # 2 confounders nobias_model <- glm(Y ~ X + C1 + C2, family = binomial(link = "logit"), data = df_sel_source ) df_observed <- data_observed( df_sel, exposure = "X", outcome = "Y_cont", confounders = c("C1", "C2") ) single_run <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est <- vector() for (i in 1:nreps) { bdf <- df_sel[sample(seq_len(n), n, replace = TRUE), ] df_observed <- data_observed( bdf, exposure = "X", outcome = "Y", confounders = c("C1", "C2") ) results <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est[i] <- results$estimate } or_true <- exp(summary(nobias_model)$coef[2, 1]) or_adjusted <- median(est) test_that("odds ratio and confidence interval output", { expect_gt(or_adjusted, or_true - 0.1) expect_lt(or_adjusted, or_true + 0.1) expect_vector( single_run$ci, ptype = double(), size = 2 ) }) # 3 confounders nobias_model <- glm(Y ~ X + C1 + C2 + C3, family = binomial(link = "logit"), data = df_sel_source ) df_observed <- data_observed( df_sel, exposure = "X", outcome = "Y_cont", confounders = c("C1", "C2", "C3") ) single_run <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est <- vector() for (i in 1:nreps) { bdf <- df_sel[sample(seq_len(n), n, replace = TRUE), ] df_observed <- data_observed( bdf, exposure = "X", outcome = "Y", confounders = c("C1", "C2", "C3") ) results <- adjust_sel( df_observed, s_model_coefs = c( s_model$coef[1], s_model$coef[2], s_model$coef[3] ) ) est[i] <- results$estimate } or_true <- exp(summary(nobias_model)$coef[2, 1]) or_adjusted <- median(est) test_that("odds ratio and confidence interval output", { expect_gt(or_adjusted, or_true - 0.1) expect_lt(or_adjusted, or_true + 0.1) expect_vector( single_run$ci, ptype = double(), size = 2 ) }) # adjust with validation data or_val <- adjust_sel( data_observed = data_observed( df_sel, exposure = "X", outcome = "Y", confounders = c("C1", "C2", "C3") ), data_validation = data_validation( df_sel_source, true_exposure = "X", true_outcome = "Y", confounders = c("C1", "C2", "C3"), selection = "S" ) ) test_that("adjust_sel, validation data", { expect_gt(or_val$estimate, or_true - 0.1) expect_lt(or_val$estimate, or_true + 0.1) })