#---------------------------------------------------------------------------------------------------------------- # # A Comparison of Covariate Adjustment Approaches under Model Misspecification # in Individually Randomized Trials: Additional Files # # # This R file contains functions which analyse the datasets in the simulations # #---------------------------------------------------------------------------------------------------------------- #------------------------------------------------------------------------------- # Continuous Outcome #------------------------------------------------------------------------------- # Unadjusted fttest <- function(indata, outcome, treat){ # Form of outcome model (outcome depends only on treatment) form.y <- as.formula(paste(outcome, "~", treat)) # Fit simple linear regression model fit_ttest <- lm(form.y, data=indata) # Estimate, SE, t and p are contained in object: summary(fit_ttest)$coefficients res_ttest <- data.frame("ttest_diff" = fit_ttest$coefficients[2], "ttest_se" = summary(fit_ttest)$coefficients[2, 2], "ttest_cl" = fit_ttest$coef[2]-qt(0.975,fit_ttest$df.residual)*summary(fit_ttest)$coefficients[2, 2], "ttest_cu" = fit_ttest$coef[2]+qt(0.975,fit_ttest$df.residual)*summary(fit_ttest)$coefficients[2, 2], "ttest_p" = summary(fit_ttest)$coefficients[2, 4]) # Return matrix containing estimate, SE, CI and p return(res_ttest) } # ANCOVA fancova <- function(indata, outcome, treat, covariate){ # Typical use: fancova(dataname, "y1", "treat", "x") # Form of outcome model (outcome depends linearly on treatment and single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+", covariate)) # Fit linear regression model fit_ancova <- lm(form.y, data=indata) # Pick up estimate, SE, t and p res_ancova <- data.frame("ancova_diff" = fit_ancova$coef[2], "ancova_se" = summary(fit_ancova)$coefficients[2, 2], "ancova_cl" = fit_ancova$coef[2]-qt(0.975, fit_ancova$df.residual)*summary(fit_ancova)$coefficients[2, 2], "ancova_cu" = fit_ancova$coef[2]+qt(0.975, fit_ancova$df.residual)*summary(fit_ancova)$coefficients[2, 2], "ancova_p" = summary(fit_ancova)$coefficients[2, 4]) # Return matrix containing estimate, SE, CI and p return(res_ancova) } # Spline fspline <- function(indata, outcome, treat, covariate, df){ # Typical use: fspline(dataname, "y1", "treat", "x", 6) # Form of outcome model (outcome depends linearly on treatment and single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+ ns(", covariate, ", df=", df, ")")) # Fit linear regression model fit_spline <- lm(form.y, data=indata) # Pick up estimate, SE, t and p res_spline <- data.frame("spline_diff" = fit_spline$coef[2], "spline_se" = sqrt(diag(vcov(fit_spline)))[2], "spline_cl" = fit_spline$coef[2]-qt(0.975, fit_spline$df.residual)*sqrt(diag(vcov(fit_spline)))[2], "spline_cu" = fit_spline$coef[2]+qt(0.975, fit_spline$df.residual)*sqrt(diag(vcov(fit_spline)))[2], "spline_p" = 2*(1-pnorm(abs(fit_spline$coef[2]/sqrt(diag(vcov(fit_spline)))[2])))) # Return matrix containing estimate, SE, CI and p return(res_spline) } # Correct regression model fcorrect <- function(indata, outcome, treat, covariate){# # Typical use: fcorrect(dataname, "y1", "treat", "x") # NOTE: Assume outcomes drawn from y1 model have names beginning with y1 # Form of outcome model if (substring(outcome, 1, 2)=="y1") { form.y = as.formula(paste0(outcome, "~", treat, "+ ", covariate)) } else if (substring(outcome, 1, 2) %in% c("y2", "y4", "y5")) { form.y = as.formula(paste0(outcome, "~", treat, "+", covariate, "+ I(", covariate, "**2)")) } else if (substring(outcome, 1, 2)=="y3") { form.y = as.formula(paste0(outcome, "~", treat, "+ exp(-", covariate, ")")) } else if (substring(outcome, 1, 2)=="y6") { form.y = as.formula(paste(outcome, "~", treat, "+ cos(2*pi*3*", covariate, "*0.15) + sin(2*pi*3*", covariate, "*0.15)")) } else if (substring(outcome, 1, 2)=="y7") { form.y = as.formula(paste0(outcome, "~", treat, "+ I(", covariate, ">0)")) } # Fit linear regression model fit_correct <- lm(form.y, data=indata) # Pick up estimate, SE, t and p res_correct <- data.frame("correct_diff" = fit_correct$coef[2], "correct_se" = summary(fit_correct)$coefficients[2, 2], "correct_cl" = fit_correct$coef[2]-qt(0.975, fit_correct$df.residual)*summary(fit_correct)$coefficients[2, 2], "correct_cu" = fit_correct$coef[2]+qt(0.975, fit_correct$df.residual)*summary(fit_correct)$coefficients[2, 2], "correct_p" = summary(fit_correct)$coefficients[2, 4]) # Return matrix containing estimate, SE, CI and p return(res_correct) } # IPTW fiptw <- function(indata, outcome, treat, covariate){ # Typical use: fiptw(dataname, "y1", "treat", "x") # Form of PS model (treatment depends on single covariate) form.ps <- as.formula(paste(treat, "~", covariate)) # Obtain IPTW estimate fit_iptw <- psw(data = indata, form.ps = form.ps, weight = "ATE", wt = TRUE, out.var = outcome, family = "gaussian") fit_W <- as.numeric(summary(fit_iptw$W)) # Pick up estimate, SE, t and p res_iptw <- data.frame("iptw_diff" = fit_iptw$est.wt, "iptw_se" = fit_iptw$std.wt, "iptw_cl" = fit_iptw$est.wt - qnorm(0.975)*fit_iptw$std.wt, "iptw_cu" = fit_iptw$est.wt + qnorm(0.975)*fit_iptw$std.wt, "iptw_p" = 2*(1-pnorm(abs(fit_iptw$est.wt/fit_iptw$std.wt))), "w_min" = fit_W[1], "w_1q" = fit_W[2], "w_median" = fit_W[3], "w_mean" = fit_W[4], "w_3q" = fit_W[5], "w_max" = fit_W[6]) # Return matrix containing estimate, SE, CI and p return(res_iptw) } # IPTW with spline fiptw_spline <- function(indata, outcome, treat, covariate){ # Typical use: fiptw_spline(dataname, "y1", "treat", "x") # Form of PS model (treatment depends on single covariate) form.ps <- as.formula(paste(treat, "~ ns(", covariate, ", df=4)")) # Obtain IPTW estimate with splines fit_iptw <- PSweight(data = indata, ps.formula = form.ps, weight = "IPW", yname= outcome, family = "gaussian") # Pick up estimate, SE, t and p res_iptw <- data.frame("iptw_spline_diff" = summary(fit_iptw)$estimates[1], "iptw_spline_se" = summary(fit_iptw)$estimates[2], "iptw_spline_cl" = summary(fit_iptw)$estimates[4], "iptw_spline_cu" = summary(fit_iptw)$estimates[5], "iptw_spline_p" = summary(fit_iptw)$estimates[6]) # Return matrix containing estimate, SE, CI and p return(res_iptw) } # AIPTW faiptw <- function(indata, outcome, treat, covariate){ # Typical use: faiptw(dataname, "y1", "treat", "x") # Form of PS and outcome models (treatment/outcome depends on single covariate)) form.ps <- as.formula(paste(treat, "~", covariate)) form.y <- as.formula(paste(outcome, "~", covariate)) # Fit AIPTW model, with PS and outcome models both depending on single covariate fit_aiptw <- psw(data = indata, form.ps = form.ps, weight = "ATE", aug = TRUE, form.outcome = form.y, family = "gaussian") # Pick up estimate, SE, t and p res_aiptw <- data.frame("aiptw_diff" = fit_aiptw$est.aug, "aiptw_se" = fit_aiptw$std.aug, "aiptw_cl" = fit_aiptw$est.aug - qnorm(0.975)*fit_aiptw$std.aug, "aiptw_cu" = fit_aiptw$est.aug + qnorm(0.975)*fit_aiptw$std.aug, "aiptw_p" = 2*(1-pnorm(abs(fit_aiptw$est.aug/fit_aiptw$std.aug)))) # Return matrix containing estimate, SE, CI and p return(res_aiptw) } # G-computation, same relationship in each arm fgcomp <- function(indata, outcome, treat, covariate){ # Typical use: fgcomp(dataname, "y1", "treat", "x") # Pick up treatment variable treat <- "treat" # Form of outcome model (outcome depends linearly on treatment and single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+", covariate)) # Fit linear regression model, with outcome model depending on single covariate fit_gcomp_prelim <- glm(form.y, family=gaussian(link="identity"), data=indata) # Standardise fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat") fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0) # Pick up estimate, SE, t and p res_gcomp <- data.frame("gcomp_diff" = fit_gcomp$est.table[2,1], "gcomp_se" = fit_gcomp$est.table[2,2], "gcomp_cl" = fit_gcomp$est.table[2,3], "gcomp_cu" = fit_gcomp$est.table[2,4], "gcomp_p" = 2*(1-pnorm(abs(fit_gcomp$est.table[2,1]/fit_gcomp$est.table[2,2])))) # Return matrix containing estimate, SE, CI and p return(res_gcomp) } #G-computation, Different covariate-outcome relationship in each arm fgcomp_int <- function(indata, outcome, treat, covariate){ # Typical use: fgcomp_int(dataname, "y1", "treat", "x") # Pick up treatment variable treat <- "treat" # Form of outcome model (outcome depends linearly on treatment and single covariate) form.y <- as.formula(paste0(outcome, " ~ ", treat, "*", covariate)) # Fit linear regression model, with outcome model depending on single covariate fit_gcomp_prelim <- glm(form.y, family=gaussian(link="identity"), data=indata) # Standardise fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat") fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0) # Pick up estimate, SE, t and p res_gcomp <- data.frame("gcomp_int_diff" = fit_gcomp$est.table[2,1], "gcomp_int_se" = fit_gcomp$est.table[2,2], "gcomp_int_cl" = fit_gcomp$est.table[2,3], "gcomp_int_cu" = fit_gcomp$est.table[2,4], "gcomp_int_p" = 2*(1-pnorm(abs(fit_gcomp$est.table[2,1]/fit_gcomp$est.table[2,2])))) # Return matrix containing estimate, SE, CI and p return(res_gcomp) } #G-computation, Different covariate-outcome relationship in each arm with splines fgcomp_int_spline <- function(indata, outcome, treat, covariate){ # Typical use: fgcomp_int_spline(dataname, "y1", "treat", "x") # Pick up treatment variable treat <- "treat" # Form of outcome model (outcome depends linearly on treatment and single covariate) form.y <- as.formula(paste0(outcome, " ~ ", treat, "* ns(", covariate, ", df=4)")) # Fit linear regression model, with outcome model depending on single covariate fit_gcomp_prelim <- glm(form.y, family=gaussian(link="identity"), data=indata) # Standardise fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat") fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0) # Pick up estimate, SE, t and p res_gcomp <- data.frame("gcomp_int_spline_diff" = fit_gcomp$est.table[2,1], "gcomp_int_spline_se" = fit_gcomp$est.table[2,2], "gcomp_int_spline_cl" = fit_gcomp$est.table[2,3], "gcomp_int_spline_cu" = fit_gcomp$est.table[2,4], "gcomp_int_spline_p" = 2*(1-pnorm(abs(fit_gcomp$est.table[2,1]/fit_gcomp$est.table[2,2])))) # Return matrix containing estimate, SE, CI and p return(res_gcomp) } # TMLE ftmle <- function(indata, outcome, treat, covariate, SL){ # Typical use: ftmle(dataname, "y1", "treat", "x", "No") # SL options are "No" or "Yes" if (SL=="No"){ # Pick up variables containing outcome, treatment and covariate Y <- indata[, outcome] A <- indata[, treat] W <- matrix(cbind(indata[, covariate], indata[, covariate]), ncol=2) colnames(W) <- c("W1", "W2") # Obtain TMLE estimate (no super learner) rtmle <- tmle(Y, A, W, family="gaussian", Qform = Y ~ A + W1, gform = A ~ W1) # Pick up estimate, SE, t and p res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE))) names(res_tmle) <- c("tmle_diff","tmle_se","tmle_cl","tmle_cu","tmle_p") res_tmle$tmle_se <- sqrt(res_tmle$tmle_se) } if (SL=="Yes"){ # Pick up variables containing outcome, treatment and covariate Y <- indata[, outcome] A <- indata[, treat] W <- cbind(indata[, covariate], indata[, covariate]) # Obtain TMLE estimate (with super learner) rtmle <- tmle(Y, A, W, family="gaussian", automate=TRUE) # Pick up estimate, SE, t and p res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE))) names(res_tmle) <- c("tmle_SL_diff","tmle_SL_se","tmle_SL_cl","tmle_SL_cu","tmle_SL_p") res_tmle$tmle_SL_se <- sqrt(res_tmle$tmle_SL_se) } # Return matrix containing estimate, SE, CI and p return(res_tmle) } #TMLE with more than one covariate ftmle_mult <- function(indata, outcome, treat, covariate, SL){ # Typical use: ftmle_mult(dataname, "y1", "treat", "x", "No") # SL options are "No" or "Yes" # Pick up variables containing outcome, treatment and covariate Y <- indata[, outcome] A <- indata[, treat] W <- indata[, covariate] # Obtain list of covariates in W names <- names(W) nameslist <- paste(as.character(names), sepby="+", collapse=" ") covlist <- substr(nameslist, 1, nchar(nameslist) - 1) # Model forms for outcome and treatment form.y <- as.formula(paste("Y ~ A + ", covlist)) form.ps <- as.formula(paste("A ~ ", covlist)) if (SL=="No"){ # Obtain TMLE estimate (no super learner) rtmle <- tmle(Y, A, W, family="gaussian", Qform = form.y, gform = form.ps) # Pick up estimate, SE, t and p res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE))) names(res_tmle) <- c("tmle_diff","tmle_se","tmle_cl","tmle_cu","tmle_p") res_tmle$tmle_se <- sqrt(res_tmle$tmle_se) } if (SL=="Yes"){ # Obtain TMLE estimate (with super learner) rtmle <- tmle(Y, A, W, family="gaussian", automate=TRUE) # Pick up estimate, SE, t and p res_tmle <- data.frame(t(unlist(rtmle$estimates$ATE))) names(res_tmle) <- c("tmle_SL_diff","tmle_SL_se","tmle_SL_cl","tmle_SL_cu","tmle_SL_p") res_tmle$tmle_SL_se <- sqrt(res_tmle$tmle_SL_se) } # Return matrix containing estimate, SE, CI and p return(res_tmle) } #------------------------------------------------------------------------------ #Binary outcome #------------------------------------------------------------------------------ # Unadjusted--------------------------------- ### Odds ratio f_or <- function(indata, outcome, treat){ # Typical use: f_or(data, "y1", "treat") # Form of outcome model (outcome depends only on treatment) form.y <- as.formula(paste(outcome, "~", treat)) # Fit simple GLM lnor_fit_unadj <- glm(form.y, data=indata, family=binomial(link="logit"), start=c(-0.2, 0)) # Extract estimate (log OR), SE, t and p lnor_res_unadj <- data.frame("lnor_unadj_diff" = lnor_fit_unadj$coefficients[2], "lnor_unadj_se" = summary(lnor_fit_unadj)$coefficients[2, 2], "lnor_unadj_cl" = lnor_fit_unadj$coef[2]-qnorm(0.975)*summary(lnor_fit_unadj)$coefficients[2, 2], "lnor_unadj_cu" = lnor_fit_unadj$coef[2]+qnorm(0.975)*summary(lnor_fit_unadj)$coefficients[2, 2], "lnor_unadj_p" = summary(lnor_fit_unadj)$coefficients[2, 4], "scale" = "log") # Return matrix containing estimate, SE, CI and p return(lnor_res_unadj) } ### Risk ratio f_rr <- function(indata, outcome, treat){ # Typical use: f_rr(data, "y1", "treat") # Form of outcome model (outcome depends only on treatment) form.y <- as.formula(paste(outcome, "~", treat)) # Fit simple GLM lnrr_fit_unadj <- glm(form.y, data=indata, family=binomial(link="log"), start=c(-0.2, 0)) # Extract estimate (log RR), SE, t and p lnrr_res_unadj <- data.frame("lnrr_unadj_diff" = lnrr_fit_unadj$coefficients[2], "lnrr_unadj_se" = summary(lnrr_fit_unadj)$coefficients[2, 2], "lnrr_unadj_cl" = lnrr_fit_unadj$coef[2]-qnorm(0.975)*summary(lnrr_fit_unadj)$coefficients[2, 2], "lnrr_unadj_cu" = lnrr_fit_unadj$coef[2]+qnorm(0.975)*summary(lnrr_fit_unadj)$coefficients[2, 2], "lnrr_unadj_p" = summary(lnrr_fit_unadj)$coefficients[2, 4], "scale" = "log") # Return matrix containing estimate, SE, CI and p return(lnrr_res_unadj) } ### Risk difference f_rd <- function(indata, outcome, treat){ # Typical use: f_rd(data, "y1", "treat") # Form of outcome model (outcome depends only on treatment) form.y <- as.formula(paste(outcome, "~", treat)) # Fit simple GLM rd_fit_unadj <- glm(form.y, data=indata, family=binomial(link="identity"), start=c(0.2, 0.5)) # Extract estimate (log RR), SE, t and p rd_res_unadj <- data.frame("rd_unadj_diff" = rd_fit_unadj$coefficients[2], "rd_unadj_se" = summary(rd_fit_unadj)$coefficients[2, 2], "rd_unadj_cl" = rd_fit_unadj$coef[2]-qnorm(0.975)*summary(rd_fit_unadj)$coefficients[2, 2], "rd_unadj_cu" = rd_fit_unadj$coef[2]+qnorm(0.975)*summary(rd_fit_unadj)$coefficients[2, 2], "rd_unadj_p" = summary(rd_fit_unadj)$coefficients[2, 4], "scale" = "unlog") # Return matrix containing estimate, SE, CI and p return(rd_res_unadj) } # Regression adjustment----------------------- ### Assuming linear relationship (on default scale for the parameter) ### Odds ratio f_aor <- function(indata, outcome, treat, covariate){ # Typical use: f_aor(data, "y1", "treat", "x") # Form of outcome model (outcome depends on treatment and single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+", covariate)) # Fit linear regression model lnor_fit_radj <- glm(form.y, data=indata, family=binomial(link="logit")) # Pick up estimate, SE, t and p lnor_res_radj <- data.frame("lnor_radj_diff" = lnor_fit_radj$coef[2], "lnor_radj_se" = summary(lnor_fit_radj)$coefficients[2, 2], "lnor_radj_cl" = lnor_fit_radj$coef[2]-qnorm(0.975)*summary(lnor_fit_radj)$coefficients[2, 2], "lnor_radj_cu" = lnor_fit_radj$coef[2]+qnorm(0.975)*summary(lnor_fit_radj)$coefficients[2, 2], "lnor_radj_p" = summary(lnor_fit_radj)$coefficients[2, 4], "scale" = "log") # Return matrix containing estimate, SE, CI and p return(lnor_res_radj) } ### Risk ratio f_arr <- function(indata, outcome, treat, covariate){ # Typical use: f_arr(data, "y1", "treat", "x") # Form of outcome model (outcome depends on treatment and single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+", covariate)) # Fit linear regression model lnrr_fit_radj <- glm(form.y, data=indata, family=binomial(link="log"), start=c(-0.2, 0, 0)) # Pick up estimate, SE, t and p if (lnrr_fit_radj$converged==TRUE) { lnrr_res_radj <- data.frame("lnrr_radj_diff" = lnrr_fit_radj$coef[2], "lnrr_radj_se" = summary(lnrr_fit_radj)$coefficients[2, 2], "lnrr_radj_cl" = lnrr_fit_radj$coef[2]-qnorm(0.975)*summary(lnrr_fit_radj)$coefficients[2, 2], "lnrr_radj_cu" = lnrr_fit_radj$coef[2]+qnorm(0.975)*summary(lnrr_fit_radj)$coefficients[2, 2], "lnrr_radj_p" = summary(lnrr_fit_radj)$coefficients[2, 4], "scale" = "log") } else if (lnrr_fit_radj$converged==FALSE) { lnrr_res_radj <- data.frame("lnrr_radj_diff" = 9999, "lnrr_radj_se" = 9999, "lnrr_radj_cl" = 9999, "lnrr_radj_cu" = 9999, "lnrr_radj_p" = 9999, "scale" = "log") } # Return matrix containing estimate, SE, CI and p return(lnrr_res_radj) } ### Risk difference f_ard <- function(indata, outcome, treat, covariate){ # Typical use: f_ard(data, "y1", "treat", "x") # Form of outcome model (outcome depends on treatment and single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+", covariate)) # Fit linear regression model rd_fit_radj <- glm(form.y, data=indata, family=binomial(link="identity"), start=c(0.5, 0, 0)) # Extract estimate (log RR), SE, t and p if (rd_fit_radj$converged==TRUE) { rd_res_radj <- data.frame("rd_radj_diff" = rd_fit_radj$coef[2], "rd_radj_se" = summary(rd_fit_radj)$coefficients[2, 2], "rd_radj_cl" = rd_fit_radj$coef[2]-qnorm(0.975)*summary(rd_fit_radj)$coefficients[2, 2], "rd_radj_cu" = rd_fit_radj$coef[2]+qnorm(0.975)*summary(rd_fit_radj)$coefficients[2, 2], "rd_radj_p" = summary(rd_fit_radj)$coefficients[2, 4], "scale" = "unlog") } else if (rd_fit_radj$converged==FALSE) { rd_res_radj <- data.frame("rd_radj_diff" = 9999, "rd_radj_se" = 9999, "rd_radj_cl" = 9999, "rd_radj_cu" = 9999, "rd_radj_p" = 9999, "scale" = "unlog") } # Return matrix containing estimate, SE, CI and p return(rd_res_radj) } # Spline-------------------------------------- ### Odds ratio f_or_spline <- function(indata, outcome, treat, covariate, df){ # Typical use: f_or_spline(data, "y1", "treat", "x", 4) # Form of outcome model (outcome depends on treatment and spline of single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+ ns(", covariate, ", df=", df, ")")) # Fit regression model lnor_fit_spline <- gam(form.y, family=binomial(link="logit"), data=indata) # Pick up estimate, SE, t and p lnor_res_spline <- data.frame("lnor_spline_diff" = lnor_fit_spline$coef[2], "lnor_spline_se" = sqrt(diag(vcov(lnor_fit_spline)))[2], "lnor_spline_cl" = lnor_fit_spline$coef[2]-qnorm(0.975)*sqrt(diag(vcov(lnor_fit_spline)))[2], "lnor_spline_cu" = lnor_fit_spline$coef[2]+qnorm(0.975)*sqrt(diag(vcov(lnor_fit_spline)))[2], "lnor_spline_p" = 2*(1-pnorm(abs(lnor_fit_spline$coef[2]/sqrt(diag(vcov(lnor_fit_spline))))))[2], "scale" = "log") # Return matrix containing estimate, SE, CI and p return(lnor_res_spline) } # IPTW----------------------------------------- f_bin_iptw <- function(indata, outcome, treat, covariate){ # Typical use: f_bin_iptw(data, "y1", "treat", "x") # Form of PS model (treatment depends on single covariate) form.ps <- as.formula(paste(treat, "~", covariate)) # Obtain IPTW estimate fit_iptw <- psw(data = indata, form.ps = form.ps, weight = "ATE", wt = TRUE, out.var = outcome, family = "binomial") # Log odds ratio: Pick up estimate, SE, t and p lnor_res_iptw <- data.frame("lnor_iptw_diff" = fit_iptw$est.lor.wt, "lnor_iptw_se" = fit_iptw$std.lor.wt, "lnor_iptw_cl" = fit_iptw$est.lor.wt - qnorm(0.975)*fit_iptw$std.lor.wt, "lnor_iptw_cu" = fit_iptw$est.lor.wt + qnorm(0.975)*fit_iptw$std.lor.wt, "lnor_iptw_p" = 2*(1-pnorm(abs(fit_iptw$est.lor.wt/fit_iptw$std.lor.wt))), "scale" = "log") # Risk ratio: Pick up estimate, SE, t and p (NB: Does not do log scale estimation) lnrr_res_iptw <- data.frame("lnrr_iptw_diff" = log(fit_iptw$est.rr.wt), "lnrr_iptw_se" = fit_iptw$std.rr.wt/(fit_iptw$est.rr.wt), "lnrr_iptw_cl" = log(fit_iptw$est.rr.wt - qnorm(0.975)*fit_iptw$std.rr.wt), "lnrr_iptw_cu" = log(fit_iptw$est.rr.wt + qnorm(0.975)*fit_iptw$std.rr.wt), "lnrr_iptw_p" = 2*(1-pnorm(abs(fit_iptw$est.rr.wt/fit_iptw$std.rr.wt))), "scale" = "unlog") # Risk difference: Pick up estimate, SE, t and p rd_res_iptw <- data.frame("rd_iptw_diff" = fit_iptw$est.risk.wt, "rd_iptw_se" = fit_iptw$std.risk.wt, "rd_iptw_cl" = fit_iptw$est.risk.wt - qnorm(0.975)*fit_iptw$std.risk.wt, "rd_iptw_cu" = fit_iptw$est.risk.wt + qnorm(0.975)*fit_iptw$std.risk.wt, "rd_iptw_p" = 2*(1-pnorm(abs(fit_iptw$est.risk.wt/fit_iptw$std.risk.wt))), "scale" = "unlog") # Return matrix containing estimate, SE, CI and p return(list(lnor_res_iptw, lnrr_res_iptw, rd_res_iptw)) } # AIPTW---------------------------------------- f_rd_aiptw <- function(indata, outcome, treat, covariate){ # Typical use: f_rd_aiptw(data, "y1", "treat", "x") # Form of PS and outcome models (treatment/outcome depends on single covariate)) form.ps <- as.formula(paste(treat, "~", covariate)) form.y <- as.formula(paste(outcome, "~", covariate)) # Fit AIPTW model, with PS and outcome models both depending on single covariate fit_aiptw <- psw(data = indata, form.ps = form.ps, weight = "ATE", aug = TRUE, form.outcome = form.y, family = "binomial") # Risk difference: Pick up estimate, SE, t and p rd_res_aiptw <- data.frame("rd_aiptw_diff" = fit_aiptw$est.risk.aug, "rd_aiptw_se" = fit_aiptw$std.risk.aug, "rd_aiptw_cl" = fit_aiptw$est.risk.aug - qnorm(0.975)*fit_aiptw$std.risk.aug, "rd_aiptw_cu" = fit_aiptw$est.risk.aug + qnorm(0.975)*fit_aiptw$std.risk.aug, "rd_aiptw_p" = 2*(1-pnorm(abs(fit_aiptw$est.risk.aug/fit_aiptw$std.risk.aug))), "scale" = "unlog") # Return matrix containing estimate, SE, CI and p return(rd_res_aiptw) } # G-computation-------------------------------- f_bin_gcomp <- function(indata, outcome, treat, covariate){ # Typical use: f_rd_aiptw(f_bin_gcomp, "y1", "treat", "x") # Pick up treatment variable treat <- "treat" # Form of outcome model (outcome depends linearly on treatment and single covariate) form.y <- as.formula(paste(outcome, "~", treat, "+", covariate)) # Fit linear regression model, with outcome model depending on single covariate fit_gcomp_prelim <- glm(form.y, family=binomial(link="logit"), data=indata) # Standardise fit_gcomp_std <- stdGlm(fit=fit_gcomp_prelim, data=indata, X="treat") lnor_fit_gcomp <- summary(fit_gcomp_std, transform="logit", contrast="difference", reference=0) lnrr_fit_gcomp <- summary(fit_gcomp_std, transform="log", contrast="difference", reference=0) rd_fit_gcomp <- summary(fit_gcomp_std, contrast="difference", reference=0) # Pick up estimate, SE, t and p lnor_res_gcomp <- data.frame("lnor_gcomp_diff" = lnor_fit_gcomp$est.table[2,1], "lnor_gcomp_se" = lnor_fit_gcomp$est.table[2,2], "lnor_gcomp_cl" = lnor_fit_gcomp$est.table[2,3], "lnor_gcomp_cu" = lnor_fit_gcomp$est.table[2,4], "lnor_gcomp_p" = 2*(1-pnorm(abs(lnor_fit_gcomp$est.table[2,1]/lnor_fit_gcomp$est.table[2,2]))), "scale" = "log") # Pick up estimate, SE, t and p lnrr_res_gcomp <- data.frame("lnrr_gcomp_diff" = lnrr_fit_gcomp$est.table[2,1], "lnrr_gcomp_se" = lnrr_fit_gcomp$est.table[2,2], "lnrr_gcomp_cl" = lnrr_fit_gcomp$est.table[2,3], "lnrr_gcomp_cu" = lnrr_fit_gcomp$est.table[2,4], "lnrr_gcomp_p" = 2*(1-pnorm(abs(lnrr_fit_gcomp$est.table[2,1]/lnrr_fit_gcomp$est.table[2,2]))), "scale" = "log") # Pick up estimate, SE, t and p rd_res_gcomp <- data.frame("rd_gcomp_diff" = rd_fit_gcomp$est.table[2,1], "rd_gcomp_se" = rd_fit_gcomp$est.table[2,2], "rd_gcomp_cl" = rd_fit_gcomp$est.table[2,3], "rd_gcomp_cu" = rd_fit_gcomp$est.table[2,4], "rd_gcomp_p" = 2*(1-pnorm(abs(rd_fit_gcomp$est.table[2,1]/rd_fit_gcomp$est.table[2,2]))), "scale" = "unlog") # Return matrix containing estimate, SE, CI and p return(list(lnor_res_gcomp, lnrr_res_gcomp, rd_res_gcomp)) } # TMLE---------------------------------------- f_bin_tmle <- function(indata, outcome, treat, covariate){ # Typical use: f_bin_tmle(f_bin_gcomp, "y1", "treat", "x") # Pick up variables containing outcome, treatment and covariate Y <- indata[, outcome] A <- indata[, treat] W <- matrix(cbind(indata[, covariate], indata[, covariate]), ncol=2) colnames(W) <- c("W1", "W2") # Obtain TMLE estimate (no super learner) rtmle <- tmle(Y, A, W, family="binomial", Qform = Y ~ A + W1, gform = A ~(W1) ) # Pick up estimate, SE, t and p # Risk difference rd_res_tmle <- data.frame(cbind(t(unlist(rtmle$estimates$ATE))), "scale"="unlog") names(rd_res_tmle) <- c("rd_tmle_diff","rd_tmle_se","rd_tmle_cl","rd_tmle_cu","rd_tmle_p", "scale") rd_res_tmle$rd_tmle_se <- sqrt(rd_res_tmle$rd_tmle_se) # Odds ratio lnor_res_tmle <- data.frame(cbind(t(unlist(rtmle$estimates$OR)))) lnor_res_tmle <- data.frame(cbind(lnor_res_tmle[1,1], lnor_res_tmle[1,6], lnor_res_tmle[1,2:4], "scale"="log")) names(lnor_res_tmle) <- c("lnor_tmle_diff","lnor_tmle_se","lnor_tmle_cl","lnor_tmle_cu","lnor_tmle_p", "scale") lnor_res_tmle$lnor_tmle_se <- sqrt(lnor_res_tmle$lnor_tmle_se) lnor_res_tmle$lnor_tmle_diff <- log(lnor_res_tmle$lnor_tmle_diff) lnor_res_tmle$lnor_tmle_cl <- log(lnor_res_tmle$lnor_tmle_cl) lnor_res_tmle$lnor_tmle_cu <- log(lnor_res_tmle$lnor_tmle_cu) # Risk ratio lnrr_res_tmle <- data.frame(cbind(t(unlist(rtmle$estimates$RR)))) lnrr_res_tmle <- data.frame(cbind(lnrr_res_tmle[1,1], lnrr_res_tmle[1,6], lnrr_res_tmle[1,2:4], "scale"="log")) names(lnrr_res_tmle) <- c("lnrr_tmle_diff","lnrr_tmle_se","lnrr_tmle_cl","lnrr_tmle_cu","lnrr_tmle_p", "scale") lnrr_res_tmle$lnrr_tmle_se <- sqrt(lnrr_res_tmle$lnrr_tmle_se) lnrr_res_tmle$lnrr_tmle_diff <- log(lnrr_res_tmle$lnrr_tmle_diff) lnrr_res_tmle$lnrr_tmle_cl <- log(lnrr_res_tmle$lnrr_tmle_cl) lnrr_res_tmle$lnrr_tmle_cu <- log(lnrr_res_tmle$lnrr_tmle_cu) # Return matrix containing estimate, SE, CI and p return(list(lnor_res_tmle, lnrr_res_tmle, rd_res_tmle)) } # CBPS---------------------------------------- fcbps <- function(indata, outcome, treat, covariate){ # Typical use: fcbps(dataname, "y1", "treat", "x") # Form of PS and outcome models (treatment/outcome depends on single covariate)) form.ps <- as.formula(paste(treat, "~", covariate)) form.y <- as.formula(paste(outcome, "~", treat)) # Estimate the PS, using the covariate-balancing condition psfit <- CBPS(form.ps, data = indata, ATT=0, method="exact", standardize = F) wt <- psfit$weights # Obtain the IPTW treatment effect estimate using the weights obtained design.ps <- svydesign(ids=~1, weights = ~wt, data = indata) reg_cbps <- svyglm(form.y, design = design.ps, data = indata, family="gaussian") # Pick up estimate, SE, t and p res_cbps<-data.frame("cbps_diff"=reg_cbps$coef[2], "cbps_se"=summary(reg_cbps)$coefficients[2, 2], "cbps_cl"=reg_cbps$coef[2]-qt(0.975,reg_cbps$df.residual)*summary(reg_cbps)$coefficients[2, 2], "cbps_cu"=reg_cbps$coef[2]+qt(0.975,reg_cbps$df.residual)*summary(reg_cbps)$coefficients[2, 2], "cbps_p"=summary(reg_cbps)$coefficients[2, 4]) # Return matrix containing estimate, SE, CI and p return(res_cbps) }